indicate start and finish in the echo area.
* mail/rmail.el (rmail-epa-decrypt): Disregard <pre> before armor.
Ignore more kinds of whitespace in mime headers.
Modify the decrypted mime part's mime type so it will be displayed
by default when visiting this message again.
* net/browse-url.el (browse-url-firefox-program): Prefer IceCat, doc.
(browse-url-firefox-arguments)
(browse-url-firefox-startup-arguments): Doc fix.
lib-src/update-game-score.exe.manifest -whitespace
nt/nmake.defs -whitespace
+# The upstream maintainer does not want to remove trailing whitespace.
+doc/misc/texinfo.tex -whitespace=blank-at-eol
+
# Some files should not be treated as text when diffing or merging.
*.gpg binary
*.gz binary
When using git, commit messages should use ChangeLog format, with the
following modifications:
-- Add a single short line explaining the change, then an empty line,
- then unindented ChangeLog entries.
+- Start with a single unindented summary line explaining the change,
+ then an empty line, then unindented ChangeLog entries.
You can use various Emacs functions to ease this process; see (info
"(emacs)Change Log Commands") or
http://www.gnu.org/software/emacs/manual/html_node/emacs/Change-Log-Commands.html.
-- The summary line is limited to 72 characters (enforced by a commit
- hook). If you have trouble making that a good summary, add a
- paragraph below it, before the individual file descriptions.
+- Limit lines in commit messages to 78 characters, unless they consist
+ of a single word of at most 140 characters. If you have trouble
+ fitting the summary into 78 characters, add a summarizing paragraph
+ below the empty line and before the individual file descriptions.
- If only a single file is changed, the summary line can be the normal
file first line (starting with the asterisk). Then there is no
the rationale for a change; that can be done in the commit message
between the summary line and the file entries.
+- Commit messages should contain only printable UTF-8 characters.
+
+- Commit messages should not contain the "Signed-off-by:" lines that
+ are used in some other projects.
+
** ChangeLog notes
- Emacs generally follows the GNU coding standards when it comes to
that *all* the necessary documentation updates have been made, mark
the entry with "+++". Otherwise do not mark it.
+Please see (info "(elisp)Documentation Tips") or
+https://www.gnu.org/software/emacs/manual/html_node/elisp/Documentation-Tips.html
+for more specific tips on Emacs's doc style. Use `checkdoc' to check
+for documentation errors before submitting a patch.
+
+** Test your changes.
+
+Please test your changes before committing them or sending them to the
+list.
+
+Emacs uses ERT, Emacs Lisp Regression Testing, for testing. See (info
+"(ert)") or https://www.gnu.org/software/emacs/manual/html_node/ert/
+for more information on writing and running tests.
+
+To run tests on the entire Emacs tree, run "make check" from the
+top-level directory. Most tests are in the directory
+"test/automated". From the "test/automated" directory, run "make
+<filename>" to run the tests for <filename>.el(c). See
+"test/automated/Makefile" for more information.
+
** Understanding Emacs Internals.
The best way to understand Emacs Internals is to read the code,
-2015-02-01 Joakim Verona <joakim@verona.se>
- Support for the new Xwidget feature.
- * configure.ac:
+2015-04-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port 'configure' to clang 3.5
+ * configure.ac: Add -Wno-unknown-attributes if clang; otherwise
+ clang 3.5.0 (Fedora 21 x86-64) complains
+ "/usr/include/glib-2.0/glib/gmem.h: ... warning: unknown attribute
+ '__alloc_size__' ignored". Use -Werror when checking for -nopie;
+ otherwise clang warns about -nopie instead of failing, and then
+ later it warns everytime the build uses -nopie.
+
+2015-04-03 Ulrich Müller <ulm@gentoo.org>
+
+ * configure.ac (LD_SWITCH_SYSTEM_TEMACS): Add -nopie option if it
+ is supported, in order to avoid segfaults in temacs. (Bug#18784)
+
+2015-03-27 Pete Williamson <petewil@chromium.org> (tiny change)
+
+ Add NaCl target
+ * configure.ac: Add a target for Chromium Native Client (NaCl).
+
+2015-03-29 Eli Zaretskii <eliz@gnu.org>
+
+ * build-aux/dir_top (File): Fix the description of selecting a
+ menu item by its number. (Bug#20213)
+
+2015-03-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix 'commit-msg' to cite 'CONTRIBUTE'
+ As suggested in:
+ http://lists.gnu.org/archive/html/emacs-devel/2015-03/msg00947.html
+ Also, have the two files match better.
+ * CONTRIBUTE: Match what's in build-aux/git-hooks/commit-msg.
+ * build-aux/git-hooks/commit-msg: Mention 'CONTRIBUTE'.
+
+2015-03-23 Andreas Schwab <schwab@suse.de>
+
+ * configure.ac: Fix jpeg version check to work with gcc >= 5.
+
+2015-03-21 Samer Masterson <samer@samertm.com>
+
+ * CONTRIBUTE (Test your changes.): New section.
+ (Document your changes.): Add doc tips.
+
+2015-03-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Better port of pthread usage to FreeBSD
+ * configure.ac (ac_func_list): Omit pthread_sigmask, since
+ we check for that ourselves rather than relying on gnulib.
+ (HAVE_PTHREAD, LIB_PTHREAD): Port better to FreeBSD,
+ by also checking for pthread_create, pthread_self, pthread_sigmask.
+ Tighten the test for pthread_atfork while we're at it.
+ Fixes: bug#20136
+
+ Merge from gnulib
+ This incorporates:
+ 2015-03-19 fdopendir: port better to MinGW
+ 2015-03-18 fdopendir: fix typo in comment
+ 2015-02-24 glob, etc.: port to MSVC v18 on MS-Windows 8.1
+ * lib/dirent.in.h, lib/fdopendir.c: Update from gnulib.
+ * lib/dirfd.c, m4/dirfd.m4: New files from gnulib.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+
+2015-03-02 Robert Pluim <rpluim@gmail.com> (tiny change)
+
+ * configure.ac: Error out if with-file-notification=w32 is
+ specified on Cygwin. (Bug#19909)
+
+2015-02-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don't require GNU putenv
+ * configure.ac: Use system putenv even if it lacks GNU features, as
+ we don't need them. This works around a bug in FreeBSD 10.1 getenv.
+ Fixes: bug#19874
+
+2015-02-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+ * lib/getdtablesize.c, m4/dup2.m4, m4/fcntl.m4:
+ Update from gnulib, incorporating:
+ 2015-02-23 dup2: doc and test for Android bug
+ 2015-02-23 Replace dup2() on Android
+ 2015-02-22 Android doesn't define RLIM_SAVED_*
+
+2015-02-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+ * lib/getdtablesize.c, lib/getopt.c, lib/signal.in.h, lib/tempname.c:
+ * lib/tempname.h, m4/dup2.m4, m4/fcntl.m4, m4/getdtablesize.m4:
+ Update from gnulib, incorporating:
+ 2015-02-20 getdtablesize: port better for Android
+ 2015-02-19 fcntl: Fix cross compiling
+ 2015-02-18 dup2, fcntl: cross-compile better for Android
+ 2015-02-18 getopt: don't crash on memory exhaustion
+ 2015-02-17 tempname: allow compilation with C++ (trivial)
+ 2015-02-17 dup2, fcntl: port to AIX
+ 2015-02-16 getdtablesize, dup2, fcntl: port to Android
+ 2015-02-11 getdtablesize, signal_h: Fix Android build
+ 2015-02-11 maint: various whitespace cleanups in tempname
+
+2015-02-13 Jan Djärv <jan.h.d@swipnet.se>
+
+ * configure.ac: Set locallisppath to empty for NS self contained,
+ unless --enable-loadllisppath was given (Bug#19850).
+
+2015-02-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.ac (HAVE_LIBXML2): Add missing comma.
+
+2015-02-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port to platforms lacking test -a and -o
+ * configure.ac (HAVE_LIBXML2):
+ Prefer '&&' and '||' to 'test -a' and 'test -o'.
+
+2015-02-08 Ulrich Müller <ulm@gentoo.org>
+
+ * configure.ac (--with-gameuser): Default to 'games' group instead
+ of 'games' user.
+
+2015-02-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * .gitattributes: Ignore blanks at EOL in texinfo.tex.
2015-01-28 Paul Eggert <eggert@cs.ucla.edu>
2014-11-25 Glenn Morris <rgm@gnu.org>
- * configure.ac: Fix yesterday's use of uninitialised $version.
+ * configure.ac: Fix yesterday's use of uninitialized $version.
2014-11-25 Oscar Fuentes <ofv@wanadoo.es>
+++ /dev/null
--*-org-*-
-Please see https://github.com/jave/xwidget-aux for documentation.
BROKEN_DATAGRAM_SOCKETS
BROKEN_FIONREAD
BROKEN_GET_CURRENT_DIR_NAME
-BROKEN_NON_BLOCKING_CONNECT
BROKEN_PTY_READ_AFTER_EAGAIN
DEFAULT_SOUND_DEVICE
DEVICE_SEP
+2015-03-31 Glenn Morris <rgm@gnu.org>
+
+ * update_autogen (commit): Switch prefix from "# " to "; ".
+
+2015-03-03 Kelvin White <kwhite@gnu.org>
+
+ * MAINTAINERS: Add myself to section 2.
+
+2015-03-03 Glenn Morris <rgm@gnu.org>
+
+ * admin.el (manual-meta-string): Use bug-gnu-emacs@gnu email address
+ rather than webmasters@gnu.
+
2015-01-28 Glenn Morris <rgm@gnu.org>
* update_autogen (commit): Prepend "# " to commit message.
2.
==============================================================================
+Kelvin White
+ ERC
+ lisp/erc/*
+ doc/misc/erc.texi
+
Eli Zaretskii
doc/*
lispref/*
(defconst manual-meta-string
"<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\">
-<link rev=\"made\" href=\"mailto:webmasters@gnu.org\">
+<link rev=\"made\" href=\"mailto:bug-gnu-emacs@gnu.org\">
<link rel=\"icon\" type=\"image/png\" href=\"/graphics/gnu-head-mini.png\">
<meta name=\"ICBM\" content=\"42.256233,-71.006581\">
<meta name=\"DC.title\" content=\"gnu.org\">\n\n")
("Jens-Ulrik Holger Petersen" "Jens-Ulrik Petersen")
("Jeremy Bertram Maitin-Shepard" "Jeremy Maitin-Shepard")
("Johan Bockgård" "Johan Bockgard")
+ ("John F. Carr" "John F Carr")
("John J Foerch" "John Foerch")
("John W. Eaton" "John Eaton")
("Jonathan I. Kamens" "Jonathan Kamens")
'(".*loaddefs.el$" ; not obsolete, but auto-generated
"\\.\\(bzr\\|cvs\\|git\\)ignore$" ; obsolete or uninteresting
"\\.arch-inventory$"
+ "ChangeLog\\(\\.[0-9]+\\)?\\'"
"automated/data/" ; not interesting
;; TODO lib/? Matches other things?
"build-aux/" "m4/" "Emacs.xcodeproj" "mapfiles" "\\.map\\'"
"All" "Version" "Everywhere" "Many" "Various" "files"
;; Directories.
"vms" "mac" "url" "tree-widget"
+ "info/dir"
)
"List of files and directories to ignore.
Changes to files in this list are not listed.")
("play/bruce.el" . "bruce.el")
("play/yow.el" . "yow.el")
("patcomp.el" . "patcomp.el")
+ ("emulation/ws-mode.el" . "ws-mode.el")
;; From lisp to etc/forms.
("forms-d2.el" . "forms-d2.el")
("forms-pass.el" . "forms-pass.el")
number to that of the actual release. Pick a date about a week
from now when you intend to make the release. Use M-x add-release-logs
to add the ChangeLog entries for that date to the tar file (but
- not yet to the repository). Name the tar file as
- emacs-XX.Y-rc1.tar. If all goes well in the following week, you
- can simply rename the file and use it for the actual release.
+ do not commit the entries to the repository until the actual release).
+ Name the tar file as emacs-XX.Y-rc1.tar. If all goes well in the
+ following week, you can simply rename the file and use it for the
+ actual release. If you need another release candidate, remember
+ to adjust the ChangeLog entries.
4. autoreconf -i -I m4 --force
make bootstrap
explanation, and the README file in the branch for usage
instructions.
+* Install changes only on one branch, let them get merged elsewhere if needed.
+
+In particular, install bug-fixes only on the release branch (if there
+is one) and let them get synced to the trunk; do not install them by
+hand on the trunk as well. E.g. if there is an active "emacs-24" branch
+and you have a bug-fix appropriate for the next emacs-24.x release,
+install it only on the emacs-24 branch, not on the trunk as well.
+
+Installing things manually into more than one branch makes merges more
+difficult.
+
+http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01124.html
+
+The exception is, if you know that the change will be difficult to
+merge to the trunk (eg because the trunk code has changed a lot).
+In that case, it's helpful if you can apply the change to both trunk
+and branch yourself (when committing the branch change, indicate
+in the commit log that it should not be merged to the trunk, by
+including the phrase "Not to be merged to master", or any other phrase
+that matches "merge").
+
* Installing changes from your personal branches.
If your branch has only a single commit, or many different real
echo "Committing..."
- $vcs commit -m "# Auto-commit of $type files." "$@" || return $?
+ $vcs commit -m "; Auto-commit of $type files." "$@" || return $?
[ "$vcs" = "git" ] && {
$vcs push || return $?
In Emacs Info, you can click mouse button 2 on a menu item
or cross reference to follow it to its target.
Each menu line that starts with a * is a topic you can select with "m".
+ You can also select a topic by typing its ordinal number.
Every third topic has a red * to help pick the right number to type.
* Menu:
/^#/ { next }
!/^.*$/ {
- print "Invalid character (not UTF-8) in commit message"
+ print "Invalid character (not UTF-8) in commit message; see 'CONTRIBUTE'"
status = 1
}
sub(/^squash! /, "")
if ($0 ~ "^" space) {
- print "White space at start of commit message'\''s first line"
+ print "White space at start of commit message'\''s first line; see 'CONTRIBUTE'"
status = 1
}
}
nlines == 2 && $0 ~ non_space {
- print "Nonempty second line in commit message"
+ print "Nonempty second line in commit message; see 'CONTRIBUTE'"
status = 1
}
}
78 < length && $0 ~ space {
- print "Line longer than 78 characters in commit message"
+ print "Line longer than 78 characters in commit message; see 'CONTRIBUTE'"
status = 1
}
140 < length {
- print "Word longer than 140 characters in commit message"
+ print "Word longer than 140 characters in commit message; see 'CONTRIBUTE'"
status = 1
}
/^Signed-off-by: / {
- print "'\''Signed-off-by:'\'' in commit message"
+ print "'\''Signed-off-by:'\'' in commit message; see 'CONTRIBUTE'"
status = 1
}
$0 ~ non_print {
- print "Unprintable character in commit message"
+ print "Unprintable character in commit message; see 'CONTRIBUTE'"
status = 1
}
END {
if (nlines == 0) {
- print "Empty commit message"
+ print "Empty commit message; see 'CONTRIBUTE'"
status = 1
}
exit status
],
[with_file_notification=$with_features])
-OPTION_DEFAULT_OFF([xwidgets],[enable use of some gtk widgets in Emacs buffers])
-
## For the times when you want to build Emacs but don't have
## a suitable makeinfo, and can live without the manuals.
dnl http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg01844.html
An argument prefixed by ':' specifies a group instead.])])
gameuser=
gamegroup=
+# We don't test if we can actually chown/chgrp here, because configure
+# may run without root privileges. lib-src/Makefile.in will handle
+# any errors due to missing user/group gracefully.
case ${with_gameuser} in
no) ;;
- "" | yes)
- AC_MSG_CHECKING([whether a 'games' user exists])
- if id -u games >/dev/null 2>&1; then
- AC_MSG_RESULT([yes])
- gameuser=games
- else
- AC_MSG_RESULT([no])
- fi
- ;;
+ "" | yes) gamegroup=games ;;
:*) gamegroup=`echo "${with_gameuser}" | sed -e "s/://"` ;;
*) gameuser=${with_gameuser} ;;
esac
EN_NS_SELF_CONTAINED=$enableval,
EN_NS_SELF_CONTAINED=yes)
+locallisppathset=no
AC_ARG_ENABLE(locallisppath,
[AS_HELP_STRING([--enable-locallisppath=PATH],
[directories Emacs should search for lisp files specific
if test "${enableval}" = "no"; then
locallisppath=
elif test "${enableval}" != "yes"; then
- locallisppath=${enableval}
+ locallisppath=${enableval} locallisppathset=yes
fi)
AC_ARG_ENABLE(checking,
## fi
;;
+ ## Chromium Native Client
+ *-nacl )
+ opsys=nacl
+ ;;
+
## Cygwin ports
*-*-cygwin )
opsys=cygwin
# Avoid gnulib's tests for HAVE_WORKING_O_NOATIME and HAVE_WORKING_O_NOFOLLOW,
# as we don't use them.
AC_DEFUN([gl_FCNTL_O_FLAGS])
+# Avoid gnulib's test for pthread_sigmask.
+funcs=
+for func in $ac_func_list; do
+ test $func = pthread_sigmask || AS_VAR_APPEND([funcs], [" $func"])
+done
+ac_func_list=$funcs
+# Use the system putenv even if it lacks GNU features, as we don't need them,
+# and the gnulib replacement runs afoul of a FreeBSD 10.1 bug; see Bug#19874.
+AC_CHECK_FUNCS_ONCE([putenv])
+AC_DEFUN([gl_FUNC_PUTENV],
+ [test "$ac_cv_func_putenv" = yes || REPLACE_PUTENV=1])
# Initialize gnulib right after choosing the compiler.
dnl Amongst other things, this sets AR and ARFLAGS.
gl_WARN_ADD([-Wno-tautological-constant-out-of-range-compare])
gl_WARN_ADD([-Wno-pointer-sign])
gl_WARN_ADD([-Wno-string-plus-int])
+ gl_WARN_ADD([-Wno-unknown-attributes])
fi
else
isystem='-isystem '
dnl (load "loadup") automatically unless told otherwise.
test "x$CANNOT_DUMP" = "x" && CANNOT_DUMP=no
case "$opsys" in
- your-opsys-here) CANNOT_DUMP=yes ;;
+ nacl) CANNOT_DUMP=yes ;;
esac
if test "$CANNOT_DUMP" = "yes"; then
infodir="\${ns_appresdir}/info"
mandir="\${ns_appresdir}/man"
lispdir="\${ns_appresdir}/lisp"
+ test "$locallisppathset" = no && locallisppath=""
INSTALL_ARCH_INDEP_EXTRA=
fi
case "$opsys" in
## darwin ld insists on the use of malloc routines in the System framework.
- darwin|mingw32|sol2-10) system_malloc=yes ;;
+ darwin | mingw32 | nacl | sol2-10) system_malloc=yes ;;
cygwin) hybrid_malloc=yes;;
esac
dnl Check for the POSIX thread library.
LIB_PTHREAD=
-if test "$opsys" != "mingw32"; then
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
- dnl testing for pthread_kill if Emacs uses gmalloc.c.
- if test "$GMALLOC_OBJ" = gmalloc.o; then
- emacs_pthread_function=pthread_atfork
- else
- emacs_pthread_function=pthread_kill
- fi
- OLD_LIBS=$LIBS
- AC_SEARCH_LIBS([$emacs_pthread_function], [pthread],
- [AC_DEFINE([HAVE_PTHREAD], [1],
- [Define to 1 if you have pthread (-lpthread).])
- # Some systems optimize for single-threaded programs by default, and
- # need special flags to disable these optimizations. For example, the
- # definition of 'errno' in <errno.h>.
- case $opsys in
- sol*)
- AC_DEFINE([_REENTRANT], 1,
- [Define to 1 if your system requires this in multithreaded code.]);;
- aix4-2)
- AC_DEFINE([_THREAD_SAFE], 1,
- [Define to 1 if your system requires this in multithreaded code.]);;
- esac])
- if test "X$LIBS" != "X$OLD_LIBS"; then
- eval LIB_PTHREAD=\$ac_cv_search_$emacs_pthread_function
+if test "$ac_cv_header_pthread_h" && test "$opsys" != "mingw32"; then
+ AC_CACHE_CHECK([for pthread library],
+ [emacs_cv_pthread_lib],
+ [emacs_cv_pthread_lib=no
+ OLD_CPPFLAGS=$CPPFLAGS
+ OLD_LIBS=$LIBS
+ for emacs_pthread_lib in 'none needed' -lpthread; do
+ case $emacs_pthread_lib in
+ -*) LIBS="$OLD_LIBS $emacs_pthread_lib";;
+ esac
+ AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <pthread.h>
+ #include <signal.h>
+ sigset_t old_mask, new_mask;
+ void noop (void) {}]],
+ [[pthread_t th = pthread_self ();
+ int status = 0;
+ status += pthread_create (&th, 0, 0, 0);
+ status += pthread_sigmask (SIG_BLOCK, &new_mask, &old_mask);
+ status += pthread_kill (th, 0);
+ #if ! (defined SYSTEM_MALLOC || defined HYBRID_MALLOC \
+ || defined DOUG_LEA_MALLOC)
+ /* Test for pthread_atfork only if gmalloc uses it,
+ as older-style hosts like MirBSD 10 lack it. */
+ status += pthread_atfork (noop, noop, noop);
+ #endif
+ return status;]])],
+ [emacs_cv_pthread_lib=$emacs_pthread_lib])
+ LIBS=$OLD_LIBS
+ if test "$emacs_cv_pthread_lib" != no; then
+ break
+ fi
+ done
+ CPPFLAGS=$OLD_CPPFLAGS])
+ if test "$emacs_cv_pthread_lib" != no; then
+ AC_DEFINE([HAVE_PTHREAD], 1, [Define to 1 if you have POSIX threads.])
+ case $emacs_cv_pthread_lib in
+ -*) LIB_PTHREAD=$emacs_cv_pthread_lib;;
+ esac
+ ac_cv_func_pthread_sigmask=yes
+ # Some systems optimize for single-threaded programs by default, and
+ # need special flags to disable these optimizations. For example, the
+ # definition of 'errno' in <errno.h>.
+ case $opsys in
+ hpux* | sol*)
+ AC_DEFINE([_REENTRANT], 1,
+ [Define to 1 if your system requires this in multithreaded code.]);;
+ aix4-2)
+ AC_DEFINE([_THREAD_SAFE], 1,
+ [Define to 1 if your system requires this in multithreaded code.]);;
+ esac
fi
- LIBS=$OLD_LIBS
fi
AC_SUBST([LIB_PTHREAD])
-fi
dnl Check for need for bigtoc support on IBM AIX
term_header=gtkutil.h
fi
-
-HAVE_XWIDGETS=no
-HAVE_WEBKIT=no
-HAVE_GIR=no
-
-if test "${with_xwidgets}" != "no" && test "${USE_GTK_TOOLKIT}" = "GTK3" && test "$window_system" != "none" ; then
- echo "xwidgets enabled, checking webkit, and others"
- HAVE_XWIDGETS=yes
- AC_DEFINE(HAVE_XWIDGETS, 1, [Define to 1 if you have xwidgets support.])
-dnl xwidgets
-dnl - enable only if GTK3 is enabled, and we have a window system
-dnl - check for webkit and gobject introspection
-
-
-#webkit version for gtk3.
- WEBKIT_REQUIRED=1.4.0
- WEBKIT_MODULES="webkitgtk-3.0 >= $WEBKIT_REQUIRED"
-
- if test "${with_gtk3}" = "yes"; then
- PKG_CHECK_MODULES(WEBKIT, $WEBKIT_MODULES, HAVE_WEBKIT=yes, HAVE_WEBKIT=no)
- if test $HAVE_WEBKIT = yes; then
- AC_DEFINE(HAVE_WEBKIT_OSR, 1, [Define to 1 if you have webkit_osr support.])
- fi
- fi
-
- GIR_REQUIRED=1.32.1
- GIR_MODULES="gobject-introspection-1.0 >= $GIR_REQUIRED"
- PKG_CHECK_MODULES(GIR, $GIR_MODULES, HAVE_GIR=yes, HAVE_GIR=no)
- if test $HAVE_GIR = yes; then
- AC_DEFINE(HAVE_GIR, 1, [Define to 1 if you have GIR support.])
- fi
-
-
-fi
-
CFLAGS=$OLD_CFLAGS
LIBS=$OLD_LIBS
dnl MS Windows native file monitor is available for mingw32 only.
case $with_file_notification,$opsys in
+ w32,cygwin)
+ AC_MSG_ERROR([`--with-file-notification=w32' was specified, but
+ this is only supported on MS-Windows native and MinGW32 builds.
+ Consider using gfile instead.])
+ ;;
w32,* | yes,mingw32)
AC_CHECK_HEADER(windows.h)
if test "$ac_cv_header_windows_h" = yes ; then
AH_TEMPLATE(HAVE_JPEG, [Define to 1 if you have the jpeg library (-ljpeg).])dnl
if test "${HAVE_JPEG}" = "yes"; then
AC_DEFINE(HAVE_JPEG)
- AC_EGREP_CPP([version= *(6[2-9]|[7-9][0-9])],
- [#include <jpeglib.h>
- version=JPEG_LIB_VERSION
-],
+ AC_EGREP_CPP([version 6b or later],
+ [#include <jpeglib.h>
+ #if JPEG_LIB_VERSION >= 62
+ version 6b or later
+ #endif
+ ],
[AC_DEFINE(HAVE_JPEG)],
[AC_MSG_WARN([libjpeg found, but not version 6b or later])
HAVE_JPEG=no])
AH_TEMPLATE(HAVE_JPEG, [Define to 1 if you have the jpeg library (-ljpeg).])dnl
if test "${HAVE_JPEG}" = "yes"; then
AC_DEFINE(HAVE_JPEG)
- AC_EGREP_CPP([version= *(6[2-9]|[7-9][0-9])],
+ AC_EGREP_CPP([version 6b or later],
[#include <jpeglib.h>
- version=JPEG_LIB_VERSION
-],
+ #if JPEG_LIB_VERSION >= 62
+ version 6b or later
+ #endif
+ ],
[AC_DEFINE(HAVE_JPEG)],
[AC_MSG_WARN([libjpeg found, but not version 6b or later])
HAVE_JPEG=no])
### I'm not sure what the version number should be, so I just guessed.
EMACS_CHECK_MODULES([LIBXML2], [libxml-2.0 > 2.6.17])
# Built-in libxml2 on OS X 10.8 lacks libxml-2.0.pc.
- if test "${HAVE_LIBXML2}" != "yes" -a "$opsys" = "darwin"; then
+ if test "${HAVE_LIBXML2}" != "yes" && test "$opsys" = "darwin"; then
SAVE_CPPFLAGS="$CPPFLAGS"
CPPFLAGS="$CPPFLAGS -I$xcsdkdir/usr/include/libxml2"
AC_CHECK_HEADER(libxml/HTMLparser.h,
fi
if test "${HAVE_LIBXML2}" = "yes"; then
if test "${opsys}" != "mingw32"; then
- AC_CHECK_LIB(xml2, htmlReadMemory, HAVE_LIBXML2=yes, HAVE_LIBXML2=no
+ AC_CHECK_LIB(xml2, htmlReadMemory, HAVE_LIBXML2=yes, HAVE_LIBXML2=no,
[$LIBXML2_LIBS])
else
LIBXML2_LIBS=""
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 )
+ hpux* | irix6-5 | nacl | openbsd | sol2* | unixware )
emacs_broken_SIGIO=yes
;;
AC_DEFINE(FIRST_PTY_LETTER, ['p'])
;;
- gnu-linux | gnu-kfreebsd | dragonfly | freebsd | netbsd )
+ gnu-linux | gnu-kfreebsd | dragonfly | freebsd | netbsd | nacl )
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.])
fi
# We need all of these features to handle C stack overflows.
-if test "$ac_cv_header_sys_resource_h" = "yes" -a \
- "$ac_cv_func_getrlimit" = "yes" -a \
- "$emacs_cv_func_sigsetjmp" = "yes" -a \
- "$emacs_cv_alternate_stack" = yes; then
+if test "$ac_cv_header_sys_resource_h" = "yes" &&
+ test "$ac_cv_func_getrlimit" = "yes" &&
+ test "$emacs_cv_func_sigsetjmp" = "yes" &&
+ test "$emacs_cv_alternate_stack" = yes; then
AC_DEFINE([HAVE_STACK_OVERFLOW_HANDLING], 1,
[Define to 1 if C stack overflow can be handled in some cases.])
fi
AC_CACHE_CHECK([for usable FIONREAD], [emacs_cv_usable_FIONREAD],
[case $opsys in
- aix4-2)
+ aix4-2 | nacl)
dnl BUILD 9008 - FIONREAD problem still exists in X-Windows.
emacs_cv_usable_FIONREAD=no
;;
case "$USE_X_TOOLKIT" in
MOTIF) TOOLKIT_LIBW="$MOTIF_LIBW" ;;
LUCID) TOOLKIT_LIBW="$LUCID_LIBW" ;;
- none) test "x$HAVE_GTK" = "xyes" && TOOLKIT_LIBW="$GTK_LIBS -lXcomposite" ;;
+ none) test "x$HAVE_GTK" = "xyes" && TOOLKIT_LIBW="$GTK_LIBS" ;;
esac
AC_SUBST(TOOLKIT_LIBW)
esac
;;
- openbsd) LD_SWITCH_SYSTEM_TEMACS='-nopie' ;;
-
*) LD_SWITCH_SYSTEM_TEMACS= ;;
esac
+# -nopie fixes a temacs segfault on Gentoo, OpenBSD, and other systems
+# with "hardened" GCC configurations for some reason (Bug#18784).
+# We don't know why -nopie works, but not segfaulting is better than
+# segfaulting. Use -Werror when trying -nopie, otherwise clang keeps
+# warning that it does not understand -nopie.
+AC_CACHE_CHECK([whether $CC accepts -nopie],
+ [emacs_cv_prog_cc_nopie],
+ [emacs_save_CFLAGS=$CFLAGS
+ emacs_save_LDFLAGS=$LDFLAGS
+ CFLAGS="$CFLAGS -Werror"
+ LDFLAGS="$LDFLAGS -nopie"
+ AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])],
+ [emacs_cv_prog_cc_nopie=yes],
+ [emacs_cv_prog_cc_nopie=no])
+ CFLAGS=$emacs_save_CFLAGS
+ LDFLAGS=$emacs_save_LDFLAGS])
+if test "$emacs_cv_prog_cc_nopie" = yes; then
+ LD_SWITCH_SYSTEM_TEMACS="$LD_SWITCH_SYSTEM_TEMACS -nopie"
+fi
+
if test x$ac_enable_profiling != x ; then
case $opsys in
*freebsd | gnu-linux) ;;
echo " Does Emacs directly use zlib? ${HAVE_ZLIB}"
echo " Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}"
-
-echo " Does Emacs support Xwidgets? ${HAVE_XWIDGETS}"
-echo " Does xwidgets support webkit(requires gtk3)? ${HAVE_WEBKIT}"
-echo " Does xwidgets support gobject introspection? ${HAVE_GIR}"
echo
if test -n "${EMACSDATA}"; then
+2015-03-29 Dani Moncayo <dmoncayo@gmail.com>
+
+ * files.texi (Diff Mode): Doc fix.
+
+2015-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ * misc.texi (Term Mode):
+ * programs.texi (Basic Indent, Custom C Indent):
+ * mini.texi (Minibuffer History):
+ * text.texi (Org Mode):
+ * display.texi (View Mode): Use @kbd where @key was mistakenly
+ used. (Bug#20135)
+
+2015-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ * basic.texi (Moving Point): Improve indexing for HOME and END.
+
+ * cmdargs.texi (General Variables): Improve indexing for
+ environment variables.
+
+ * msdog.texi (Windows HOME):
+ * msdog-xtra.texi (MS-DOS File Names): Remove markup from HOME in
+ the index entries. (Bug#20105)
+
+2015-02-26 Eli Zaretskii <eliz@gnu.org>
+
+ * msdog.texi (Windows Files): Document characters invalid in
+ Windows file names. (Bug#19463)
+
+ * custom.texi (Customization Groups): Update the looks of the
+ Customize Group buffer.
+
+ * programs.texi (Hungry Delete): Fix a typo: "C-d" instead of
+ "C-c C-d" in hungry-delete mode.
+
+2015-02-26 Eli Zaretskii <eliz@gnu.org>
+
+ * mule.texi (Language Environments): Work around refill bug in
+ makeinfo 4.x. (Bug#19697)
+
2015-01-28 Eli Zaretskii <eliz@gnu.org>
* cmdargs.texi (Action Arguments): Clarify into which buffer
@item
Andrew Choi and Yamamoto Mitsuharu wrote the Carbon support, used
-prior to Emacs 23 for Mac OS. Yamamoto Mitsuharu continued to
+prior to Emacs 23 for Mac OS@. Yamamoto Mitsuharu continued to
contribute to Mac OS support in the newer Nextstep port; and also
improved support for multi-monitor displays.
@item C-a
@itemx @key{Home}
@kindex C-a
-@kindex HOME
+@kindex HOME key
@findex move-beginning-of-line
Move to the beginning of the line (@code{move-beginning-of-line}).
@item C-e
@itemx @key{End}
@kindex C-e
-@kindex END
+@kindex END key
@findex move-end-of-line
Move to the end of the line (@code{move-end-of-line}).
becomes @samp{file\middle\top}, while @code{post-forward} puts them in
forward order after the file name, as in @samp{file|top/middle}. If
@code{uniquify-buffer-name-style} is set to @code{nil}, the buffer
-names simply get @samp{<2>}, @samp{<3>}, etc. appended.
+names simply get @samp{<2>}, @samp{<3>}, etc.@: appended.
Which rule to follow for putting the directory names in the buffer
name is not very important if you are going to @emph{look} at the
some other programs. Emacs does not require any of these environment
variables to be set, but it uses their values if they are set.
-@vtable @env
+@c This used to be @vtable, but that enters the variables alone into
+@c the Variable Index, which in some cases, like ``HOME'', might be
+@c confused with keys by that name, and other cases, like ``NAME'',
+@c might be confused with general-purpose phrases.
+@table @env
@item CDPATH
+@vindex CDPATH, environment variable
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
+@vindex DBUS_SESSION_BUS_ADDRESS, environment variable
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=/dev/null}, suppresses connections to the D-Bus session
bus as well as autolaunching the D-Bus session bus if not running yet.
@item EMACSDATA
+@vindex EMACSDATA, environment variable
Directory for the architecture-independent files that come with Emacs.
This is used to initialize the variable @code{data-directory}.
@item EMACSDOC
+#vindex EMACSDOC, environment variable
Directory for the documentation string file, which is used to
initialize the Lisp variable @code{doc-directory}.
@item EMACSLOADPATH
+#vindex EMACSLOADPATH, environment variable
A colon-separated list of directories@footnote{Here and below,
whenever we say ``colon-separated list of directories'', it pertains
to Unix and GNU/Linux systems. On MS-DOS and MS-Windows, the
middle of the list, use 2 colons in a row, as in
@samp{EMACSLOADPATH="/tmp::/foo"}.
@item EMACSPATH
+@vindex EMACSPATH, environment variable
A colon-separated list of directories to search for executable files.
If set, Emacs uses this in addition to @env{PATH} (see below) when
initializing the variable @code{exec-path} (@pxref{Shell}).
@item EMAIL
+@vindex EMAIL, environment variable
@vindex user-mail-address@r{, initialization}
Your email address; used to initialize the Lisp variable
@code{user-mail-address}, which the Emacs mail interface puts into the
@samp{From} header of outgoing messages (@pxref{Mail Headers}).
@item ESHELL
+@vindex ESHELL, environment variable
Used for shell-mode to override the @env{SHELL} environment variable
(@pxref{Interactive Shell}).
@item HISTFILE
+@vindex HISTFILE, environment variable
The name of the file that shell commands are saved in between logins.
This variable defaults to @file{~/.bash_history} if you use Bash, to
@file{~/.sh_history} if you use ksh, and to @file{~/.history}
otherwise.
@item HOME
+@vindex HOME, environment variable
The location of your files in the directory tree; used for
expansion of file names starting with a tilde (@file{~}). On MS-DOS,
it defaults to the directory from which Emacs was started, with
compatibility @file{C:/} will be used instead if a @file{.emacs} file
is found there.
@item HOSTNAME
+@vindex HOSTNAME, environment variable
The name of the machine that Emacs is running on.
@c complete.el is obsolete since 24.1.
@ignore
to search for files.
@end ignore
@item INFOPATH
+@vindex INFOPATH, environment variable
A colon-separated list of directories in which to search for Info files.
@item LC_ALL
+@vindex LC_ALL, environment variable
@itemx LC_COLLATE
+@vindex LC_COLLATE, environment variable
@itemx LC_CTYPE
+@vindex LC_CTYPE, environment variable
@itemx LC_MESSAGES
+@vindex LC_MESSAGES, environment variable
@itemx LC_MONETARY
+@vindex LC_MONETARY, environment variable
@itemx LC_NUMERIC
+@vindex LC_NUMERIC, environment variable
@itemx LC_TIME
+@vindex LC_TIME, environment variable
@itemx LANG
+@vindex LANG, environment variable
The user's preferred locale. The locale has six categories, specified
by the environment variables @env{LC_COLLATE} for sorting,
@env{LC_CTYPE} for character encoding, @env{LC_MESSAGES} for system
@code{locale-preferred-coding-systems}, to select a default language
environment and coding system. @xref{Language Environments}.
@item LOGNAME
+@vindex LOGNAME, environment variable
The user's login name. See also @env{USER}.
@item MAIL
+@vindex MAIL, environment variable
The name of your system mail inbox.
@ifnottex
@item MH
+@vindex MH, environment variable
Name of setup file for the mh system. @xref{Top,,MH-E,mh-e, The Emacs
Interface to MH}.
@end ifnottex
@item NAME
+@vindex NAME, environment variable
Your real-world name. This is used to initialize the variable
@code{user-full-name} (@pxref{Mail Headers}).
@item NNTPSERVER
+@vindex NNTPSERVER, environment variable
The name of the news server. Used by the mh and Gnus packages.
@item ORGANIZATION
+@vindex ORGANIZATION, environment variable
The name of the organization to which you belong. Used for setting the
`Organization:' header in your posts from the Gnus package.
@item PATH
+@vindex PATH, environment variable
A colon-separated list of directories containing executable files.
This is used to initialize the variable @code{exec-path}
(@pxref{Shell}).
@item PWD
+@vindex PWD, environment variable
If set, this should be the default directory when Emacs was started.
@item REPLYTO
+@vindex REPLYTO, environment variable
If set, this specifies an initial value for the variable
@code{mail-default-reply-to} (@pxref{Mail Headers}).
@item SAVEDIR
+@vindex SAVEDIR, environment variable
The name of a directory in which news articles are saved by default.
Used by the Gnus package.
@item SHELL
+@vindex SHELL, environment variable
The name of an interpreter used to parse and execute programs run from
inside Emacs.
@item SMTPSERVER
+@vindex SMTPSERVER, environment variable
The name of the outgoing mail server. This is used to initialize the
variable @code{smtpmail-smtp-server} (@pxref{Mail Sending}).
@cindex background mode, on @command{xterm}
@item TERM
+@vindex TERM, environment variable
The type of the terminal that Emacs is using. This variable must be
set unless Emacs is run in batch mode. On MS-DOS, it defaults to
@samp{internal}, which specifies a built-in terminal emulation that
handles the machine's own display.
@item TERMCAP
+@vindex TERMCAP, environment variable
The name of the termcap library file describing how to program the
terminal specified by @env{TERM}. This defaults to
@file{/etc/termcap}.
@item TMPDIR
+@vindex TMPDIR, environment variable
@itemx TMP
+@vindex TMP, environment variable
@itemx TEMP
+@vindex TEMP, environment variable
These environment variables are used to initialize the variable
@code{temporary-file-directory}, which specifies a directory in which
to put temporary files (@pxref{Backup}). Emacs tries to use
@env{TMPDIR} first. If that is unset, Emacs normally falls back on
@file{/tmp}, but on MS-Windows and MS-DOS it instead falls back on
@env{TMP}, then @env{TEMP}, and finally @file{c:/temp}.
-
@item TZ
+@vindex TZ, environment variable
This specifies the current time zone and possibly also daylight
saving time information. On MS-DOS, if @env{TZ} is not set in the
environment when Emacs starts, Emacs defines a default value as
appropriate for the country code returned by DOS@. On MS-Windows, Emacs
does not use @env{TZ} at all.
@item USER
+@vindex USER, environment variable
The user's login name. See also @env{LOGNAME}. On MS-DOS, this
defaults to @samp{root}.
@item VERSION_CONTROL
+@vindex VERSION_CONTROL, environment variable
Used to initialize the @code{version-control} variable (@pxref{Backup
Names}).
-@end vtable
+@end table
@node Misc Variables
@appendixsubsec Miscellaneous Variables
@c @page
@smallexample
@group
-To apply changes, use the Save or Set buttons.
-For details, see [Saving Customizations] in the [Emacs manual].
+For help, see [Easy Customization] in the [Emacs manual].
________________________________________ [ Search ]
Operate on all settings in this buffer:
- [ Set for current session ] [ Save for future sessions ]
- [ Undo edits ] [ Reset to saved ] [ Erase customizations ] [ Exit ]
+ [ Revert... ] [ Apply ] [ Apply and Save ]
Emacs group: Customization of the One True Editor.
See also [Manual].
[Editing] : Basic text editing facilities.
-
[Convenience] : Convenience features for faster editing.
@var{more second-level groups}
any unfontified text they scroll over, instead to assume it has the
default face. This can cause Emacs to scroll to somewhat wrong buffer
positions when the faces in use are not all the same size, even with
-single (i.e. without auto-repeat) scrolling operations.
+single (i.e., without auto-repeat) scrolling operations.
@vindex scroll-up
@vindex scroll-down
screenfuls. It provides commands for scrolling through the buffer
conveniently but not for changing it. Apart from the usual Emacs
cursor motion commands, you can type @key{SPC} to scroll forward one
-windowful, @key{S-@key{SPC}} or @key{DEL} to scroll backward, and @kbd{s} to
+windowful, @kbd{S-@key{SPC}} or @key{DEL} to scroll backward, and @kbd{s} to
start an incremental search.
@kindex q @r{(View mode)}
@item lines
@vindex whitespace-line-column
-Highlight lines longer than 80 lines. To change the column limit,
+Highlight lines longer than 80 columns. To change the column limit,
customize the variable @code{whitespace-line-column}.
@item newline
change the variable @code{diff-update-on-the-fly} to @code{nil}.
Diff mode treats each hunk as an ``error message'', similar to
-Compilation mode. Thus, you can use commands such as @kbd{C-x '} to
+Compilation mode. Thus, you can use commands such as @kbd{C-x `} to
visit the corresponding source locations. @xref{Compilation Mode}.
In addition, Diff mode provides the following commands to navigate,
@cindex overscrolling
If you're using Emacs on X (with GTK+ or Motif), you can customize the
variable @code{scroll-bar-adjust-thumb-portion} to control
-@dfn{overscrolling} of the scroll bar, i.e. dragging the thumb down even
+@dfn{overscrolling} of the scroll bar, i.e., dragging the thumb down even
when the end of the buffer is visible. If its value is
non-@code{nil}, the scroll bar can be dragged downwards even if the
end of the buffer is shown; if @code{nil}, the thumb will be at the
The command @kbd{C-x @key{SPC}} (@code{rectangle-mark-mode}) toggles
whether the region-rectangle or the standard region is highlighted
(first activating the region if necessary). When this mode is enabled,
-commands that resize the region (@kbd{C-f}, @kbd{C-n} etc.) do
+commands that resize the region (@kbd{C-f}, @kbd{C-n} etc.)@: do
so in a rectangular fashion, and killing and yanking operate on the
rectangle. @xref{Killing}. The mode persists only as long as the
region is active.
arguments: values that you are likely to enter. You can think of this
as moving through the ``future history'' list.
- If you edit the text inserted by the @kbd{M-p} or @key{M-n}
+ If you edit the text inserted by the @kbd{M-p} or @kbd{M-n}
minibuffer history commands, this does not change its entry in the
history list. However, the edited argument does go at the end of the
history list when you submit it.
@table @kbd
@item C-c C-c
-Send a literal @key{C-c} to the sub-shell.
+Send a literal @kbd{C-c} to the sub-shell.
@item C-c @var{char}
This is equivalent to @kbd{C-x @var{char}} in normal Emacs. For
DOS programs to access long file names, so Emacs built for MS-DOS will
only see their short 8+3 aliases.
-@cindex @env{HOME} directory under MS-DOS
+@cindex HOME directory under MS-DOS
MS-DOS has no notion of home directory, so Emacs on MS-DOS pretends
that the directory where it is installed is the value of the @env{HOME}
environment variable. That is, if your Emacs binary,
Dired and other related features. The value of @code{nil} means never
issue those system calls. Non-@code{nil} values are more useful on
NTFS volumes, which support hard links and file security, than on FAT,
-FAT32, and XFAT volumes.
+FAT32, and exFAT volumes.
+
+@cindex file names, invalid characters on MS-Windows
+ Unlike Unix, MS-Windows file systems restrict the set of characters
+that can be used in a file name. The following characters are not
+allowed:
+
+@itemize @bullet
+@item
+Shell redirection symbols @samp{<}, @samp{>}, and @samp{|}.
+
+@item
+Colon @samp{:} (except after the drive letter).
+
+@item
+Forward slash @samp{/} and backslash @samp{\} (except as directory
+separators).
+
+@item
+Wildcard characters @samp{*} and @samp{?}.
+
+@item
+Control characters whose codepoints are 1 through 31 decimal. In
+particular, newlines in file names are not allowed.
+
+@item
+The null character, whose codepoint is zero (this limitation exists on
+Unix filesystems as well).
+@end itemize
+
+@noindent
+In addition, referencing any file whose name matches a DOS character
+device, such as @file{NUL} or @file{LPT1} or @file{PRN} or @file{CON},
+with or without any file-name extension, will always resolve to those
+character devices, in any directory. Therefore, only use such file
+names when you want to use the corresponding character device.
@node ls in Lisp
@section Emulation of @code{ls} on MS-Windows
@node Windows HOME
@section HOME and Startup Directories on MS-Windows
-@cindex @code{HOME} directory on MS-Windows
+@cindex HOME directory on MS-Windows
The Windows equivalent of @code{HOME} is the @dfn{user-specific
application data directory}. The actual location depends on the
for more information about the language environment @var{lang-env}.
Supported language environments include:
+@c @cindex entries below are split between portions of the list to
+@c make them more accurate, i.e., land on the line that mentions the
+@c language. However, makeinfo 4.x doesn't fill inside @quotation
+@c lines that follow a @cindex entry and whose text has no whitespace.
+@c To work around, we group the language environments together, so
+@c that the blank that separates them triggers refill.
@quotation
@cindex ASCII
-ASCII,
@cindex Arabic
-Arabic,
+ASCII, Arabic,
@cindex Belarusian
-Belarusian,
@cindex Bengali
-Bengali,
+Belarusian, Bengali,
@cindex Brazilian Portuguese
-Brazilian Portuguese,
@cindex Bulgarian
-Bulgarian,
+Brazilian Portuguese, Bulgarian,
@cindex Burmese
-Burmese,
@cindex Cham
-Cham,
+Burmese, Cham,
@cindex Chinese
Chinese-BIG5, Chinese-CNS, Chinese-EUC-TW, Chinese-GB,
Chinese-GB18030, Chinese-GBK,
@cindex Croatian
-Croatian,
@cindex Cyrillic
-Cyrillic-ALT, Cyrillic-ISO, Cyrillic-KOI8,
+Croatian, Cyrillic-ALT, Cyrillic-ISO, Cyrillic-KOI8,
@cindex Czech
-Czech,
@cindex Devanagari
-Devanagari,
+Czech, Devanagari,
@cindex Dutch
-Dutch,
@cindex English
-English,
+Dutch, English,
@cindex Esperanto
-Esperanto,
@cindex Ethiopic
-Ethiopic,
+Esperanto, Ethiopic,
@cindex French
-French,
@cindex Georgian
-Georgian,
+French, Georgian,
@cindex German
-German,
@cindex Greek
-Greek,
@cindex Gujarati
-Gujarati,
+German, Greek, Gujarati,
@cindex Hebrew
-Hebrew,
@cindex IPA
-IPA,
+Hebrew, IPA,
@cindex Italian
Italian,
@cindex Japanese
-Japanese,
@cindex Kannada
-Kannada,
+Japanese, Kannada,
@cindex Khmer
-Khmer,
@cindex Korean
-Korean,
@cindex Lao
-Lao,
+Khmer, Korean, Lao,
@cindex Latin
Latin-1, Latin-2, Latin-3, Latin-4, Latin-5, Latin-6, Latin-7,
Latin-8, Latin-9,
@cindex Latvian
-Latvian,
@cindex Lithuanian
-Lithuanian,
+Latvian, Lithuanian,
@cindex Malayalam
-Malayalam,
@cindex Oriya
-Oriya,
+Malayalam, Oriya,
@cindex Persian
-Persian,
@cindex Polish
-Polish,
+Persian, Polish,
@cindex Punjabi
-Punjabi,
@cindex Romanian
-Romanian,
+Punjabi, Romanian,
@cindex Russian
-Russian,
@cindex Sinhala
-Sinhala,
+Russian, Sinhala,
@cindex Slovak
-Slovak,
@cindex Slovenian
-Slovenian,
@cindex Spanish
-Spanish,
+Slovak, Slovenian, Spanish,
@cindex Swedish
-Swedish,
@cindex TaiViet
-TaiViet,
+Swedish, TaiViet,
@cindex Tajik
-Tajik,
@cindex Tamil
-Tamil,
+Tajik, Tamil,
@cindex Telugu
-Telugu,
@cindex Thai
-Thai,
+Telugu, Thai,
@cindex Tibetan
-Tibetan,
@cindex Turkish
-Turkish,
+Tibetan, Turkish,
@cindex UTF-8
-UTF-8,
@cindex Ukrainian
-Ukrainian,
+UTF-8, Ukrainian,
@cindex Vietnamese
-Vietnamese,
@cindex Welsh
-Welsh, and
+Vietnamese, Welsh,
@cindex Windows-1255
-Windows-1255.
+and Windows-1255.
@end quotation
To display the script(s) used by your language environment on a
line within the region, not just the current line.
The command @key{RET} (@code{newline}), which was documented in
-@ref{Inserting Text}, does the same as @key{C-j} followed by
+@ref{Inserting Text}, does the same as @kbd{C-j} followed by
@key{TAB}: it inserts a new line, then adjusts the line's indentation.
When indenting a line that starts within a parenthetical grouping,
styles are primarily intended for one language, but any of them can be
used with any of the languages supported by these modes. To find out
what a style looks like, select it and reindent some code, e.g., by
-typing @key{C-M-q} at the start of a function definition.
+typing @kbd{C-M-q} at the start of a function definition.
@kindex C-c . @r{(C mode)}
@findex c-set-style
the closing delimiter.
@end itemize
-To toggle Electric Pair mode, type @kbd{M-x electric-pair-mode}.
+To toggle Electric Pair mode, type @kbd{M-x electric-pair-mode}. To
+toggle the mode in a single buffer, use @kbd{M-x
+electric-pair-local-mode}.
@node Comments
@section Manipulating Comments
As an alternative to the above commands, you can enable @dfn{hungry
delete mode}. When this feature is enabled (indicated by @samp{/h} in
the mode line after the mode name), a single @key{DEL} deletes all
-preceding whitespace, not just one space, and a single @kbd{C-c C-d}
+preceding whitespace, not just one space, and a single @kbd{C-d}
(but @emph{not} plain @key{Delete}) deletes all following whitespace.
@table @kbd
@kindex S-TAB @r{(Org Mode)}
@findex org-shifttab
- Typing @key{S-TAB} (@code{org-shifttab}) anywhere in an Org mode
+ Typing @kbd{S-@key{TAB}} (@code{org-shifttab}) anywhere in an Org mode
buffer cycles the visibility of the entire outline structure, between
(i) showing only top-level heading lines, (ii) showing all heading
lines but no body lines, and (iii) showing everything.
the backtrace, @var{bindir} is the name of the directory that
contains the Emacs executable, and @var{emacs-binary} is the name of
the Emacs executable file, normally @file{emacs} on GNU and Unix
-systems and @file{emacs.exe} on MS-Windows and MS-DOS. Omit the
+systems and @file{emacs.exe} on MS-Windows and MS-DOS@. Omit the
@option{-p} option if your version of @command{addr2line} is too old
to have it.
change occurs in.
If you are using the Emacs repository, make sure your copy is
-up-to-date (e.g. with @code{git pull}). You can commit your changes
+up-to-date (e.g., with @code{git pull}). You can commit your changes
to a private branch and generate a patch from the master version by
using @code{git format-patch master}. Or you can leave your changes
uncommitted and use @code{git diff}.
Please look at the change log entries of recent commits to see what
sorts of information to put in, and to learn the style that we use. Note that,
unlike some other projects, we do require change logs for
-documentation, i.e. Texinfo files.
+documentation, i.e., Texinfo files.
@xref{Change Log},
@ifset WWW_GNU_ORG
see
For general information, see the website @url{http://www.fsf.org/}.
Generally speaking, for non-trivial contributions to GNU Emacs we
-require that the copyright be assigned to the FSF. For the reasons
+require that the copyright be assigned to the FSF@. For the reasons
behind this, see @url{http://www.gnu.org/licenses/why-assign.html}.
Copyright assignment is a simple process. Residents of some countries
has to be repeated each time you want to send something new.
We can accept small changes (roughly, fewer than 15 lines) without
-an assignment. This is a cumulative limit (e.g. three separate 5 line
+an assignment. This is a cumulative limit (e.g., three separate 5 line
patches) over all your contributions.
@node Service
+2015-03-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp-intro.texi: `save-excursion' doesn't save&restore the mark.
+
2014-12-31 Paul Eggert <eggert@cs.ucla.edu>
Less 'make' chatter for Emacs doc
* if:: What if?
* else:: If--then--else expressions.
* Truth & Falsehood:: What Lisp considers false and true.
-* save-excursion:: Keeping track of point, mark, and buffer.
+* save-excursion:: Keeping track of point and buffer.
* Review::
* defun Exercises::
* Point and mark:: A review of various locations.
* Template for save-excursion::
-A Few Buffer--Related Functions
+A Few Buffer-Related Functions
* Finding More:: How to find more information.
* simplified-beginning-of-buffer:: Shows @code{goto-char},
* if:: What if?
* else:: If--then--else expressions.
* Truth & Falsehood:: What Lisp considers false and true.
-* save-excursion:: Keeping track of point, mark, and buffer.
+* save-excursion:: Keeping track of point and buffer.
* Review::
* defun Exercises::
@end menu
that we will discuss in this chapter.
In Emacs Lisp programs used for editing, the @code{save-excursion}
-function is very common. It saves the location of point and mark,
-executes the body of the function, and then restores point and mark to
-their previous positions if their locations were changed. Its primary
+function is very common. It saves the location of point,
+executes the body of the function, and then restores point to
+its previous position if its location was changed. Its primary
purpose is to keep the user from being surprised and disturbed by
-unexpected movement of point or mark.
+unexpected movement of point.
@menu
* Point and mark:: A review of various locations.
@code{print-region}.
The @code{save-excursion} special form saves the locations of point and
-mark and restores those positions after the code within the body of the
+restores this position after the code within the body of the
special form is evaluated by the Lisp interpreter. Thus, if point were
in the beginning of a piece of text and some code moved point to the end
of the buffer, the @code{save-excursion} would put point back to where
workings even though a user would not expect this. For example,
@code{count-lines-region} moves point. To prevent the user from being
bothered by jumps that are both unexpected and (from the user's point of
-view) unnecessary, @code{save-excursion} is often used to keep point and
-mark in the location expected by the user. The use of
+view) unnecessary, @code{save-excursion} is often used to keep point in
+the location expected by the user. The use of
@code{save-excursion} is good housekeeping.
To make sure the house stays clean, @code{save-excursion} restores the
-values of point and mark even if something goes wrong in the code inside
+value of point even if something goes wrong in the code inside
of it (or, to be more precise and to use the proper jargon, ``in case of
abnormal exit''). This feature is very helpful.
-In addition to recording the values of point and mark,
+In addition to recording the value of point,
@code{save-excursion} keeps track of the current buffer, and restores
it, too. This means you can write code that will change the buffer and
have @code{save-excursion} switch you back to the original buffer.
@end smallexample
@item save-excursion
-Record the values of point and mark and the current buffer before
-evaluating the body of this special form. Restore the values of point
-and mark and buffer afterward.
+Record the values of point and the current buffer before
+evaluating the body of this special form. Restore the value of point and
+buffer afterward.
@need 1250
For example,
@end itemize
@node Buffer Walk Through
-@chapter A Few Buffer--Related Functions
+@chapter A Few Buffer-Related Functions
In this chapter we study in detail several of the functions used in GNU
Emacs. This is called a ``walk-through''. These functions are used as
The body of the @code{let} expression in @code{append-to-buffer}
consists of a @code{save-excursion} expression.
-The @code{save-excursion} function saves the locations of point and
-mark, and restores them to those positions after the expressions in the
+The @code{save-excursion} function saves the location of point, and restores it
+to that position after the expressions in the
body of the @code{save-excursion} complete execution. In addition,
@code{save-excursion} keeps track of the original buffer, and
restores it. This is how @code{save-excursion} is used in
@key{META} key).
@item save-excursion
-Save the location of point and mark and restore their values after the
+Save the location of point and restore its value after the
arguments to @code{save-excursion} have been evaluated. Also, remember
the current buffer and return to it.
recorded in the variable @code{newmark}.
After the body of the outer @code{save-excursion} is evaluated, point
-and mark are relocated to their original places.
+is relocated to its original place.
However, it is convenient to locate a mark at the end of the newly
inserted text and locate point at its beginning. The @code{newmark}
@code{save-restriction} special form.
The call to @code{widen} is followed by @code{save-excursion}, which
-saves the location of the cursor (i.e., of point) and of the mark, and
-restores them after the code in the body of the @code{save-excursion}
+saves the location of the cursor (i.e., of point), and
+restores it after the code in the body of the @code{save-excursion}
uses the @code{beginning-of-line} function to move point.
(Note that the @code{(widen)} expression comes between the
current line.
After @code{count-lines} has done its job, and the message has been
-printed in the echo area, the @code{save-excursion} restores point and
-mark to their original positions; and @code{save-restriction} restores
+printed in the echo area, the @code{save-excursion} restores point to
+its original position; and @code{save-restriction} restores
the original narrowing, if any.
@node narrow Exercise
@uref{http://www.gnu.org/software/texinfo/manual/texinfo/}
@end ifhtml
@iftex
-``Indicating Definitions, Commands, etc.'' in @cite{Texinfo, The GNU
+``Indicating Definitions, Commands, etc.''@: in @cite{Texinfo, The GNU
Documentation Format}.
@end iftex
@end itemize
+2015-03-29 Glenn Morris <rgm@gnu.org>
+
+ * objects.texi (Equality Predicates): Fix typo in example.
+
+2015-03-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * positions.texi (Excursions, Narrowing): `save-excursion' does not
+ save&restore the mark any more.
+
+2015-03-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ * numbers.texi (Float Basics): Improve ldexp documentation.
+
+2015-03-23 Eli Zaretskii <eliz@gnu.org>
+
+ * commands.texi (Event Input Misc): Fix incorrect usage of @code.
+ (Bug#20174)
+ (Accessing Mouse): Expand documentation of 'posn-actual-col-row'.
+ (Bug#20169)
+ More accurate description of 'posn-object-x-y'. (Bug#20168)
+
+2015-03-23 Daiki Ueno <ueno@gnu.org>
+
+ * processes.texi (Asynchronous Processes): Mention `make-process'.
+
+2015-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ * minibuf.texi (Basic Completion): Fix a typo. (Bug#20108)
+
+2015-03-09 Nicolas Petton <nicolas@petton.fr>
+
+ * sequences.texi (seq-into): Add documentation for the new
+ seq-into function.
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * processes.texi (Synchronous Processes): Update documentation of
+ call-process-shell-command and process-file-shell-command.
+
+2015-03-03 Daniel Colascione <dancol@dancol.org>
+
+ * control.texi (Generators): Correct missing word. Clarify which
+ forms are legal in which parts of `unwind-protect'. Fix orphaned
+ close parenthesis.
+
+ * objects.texi (Finalizer Type): New section for finalizer objects.
+ (Type Predicates): Mention finalizers in `type-of' documentation.
+ * elisp.texi (Top): Link to finalizer type.
+
+2015-03-02 Daniel Colascione <dancol@dancol.org>
+
+ * control.texi (Generators): New section
+ * elisp.text: Reference new section.
+
+2015-02-28 Eli Zaretskii <eliz@gnu.org>
+
+ * searching.texi (Char Classes): Update the documentation of
+ [:alpha:] and [:alnum:]. (Bug#19878)
+
+2015-02-27 Eli Zaretskii <eliz@gnu.org>
+
+ * os.texi (Startup Summary):
+ * display.texi (Window Systems): Mention peculiarities of daemon
+ mode on MS-Windows.
+
+2015-02-11 Martin Rudalics <rudalics@gmx.at>
+
+ * frames.texi (Size Parameters): Update description of
+ fullscreen frame parameter. Describe `fullscreen-restore'
+ parameter.
+
+2015-02-09 Nicolas Petton <nicolas@petton.fr>
+
+ * sequences.texi (Sequence Functions): Update documentation
+ examples for seq-group-by.
+
+2015-02-09 Eli Zaretskii <eliz@gnu.org>
+
+ * positions.texi (Screen Lines): Update the documentation of
+ vertical-motion to document the new additional argument.
+
+2015-02-06 Nicolas Petton <nicolas@petton.fr>
+
+ * sequences.texi (Sequence Functions): Add documentation for
+ seq-mapcat, seq-partition and seq-group-by.
+
+2015-02-05 Martin Rudalics <rudalics@gmx.at>
+
+ * display.texi (Size of Displayed Text): Remove description of
+ optional argument BUFFER of `window-text-pixel-size'.
+
+2015-02-01 Martin Rudalics <rudalics@gmx.at>
+
+ * display.texi (Size of Displayed Text): Describe optional
+ argument BUFFER of `window-text-pixel-size'.
+
2015-01-28 Eli Zaretskii <eliz@gnu.org>
* searching.texi (Regexp Search): Add a cross-reference to "Syntax
of @code{describe-function} will include similar information.
The value of the property can be: a string, which the byte-compiler
will use directly in its warning (it should end with a period, and not
-start with a capital, e.g. ``use @dots{} instead.''); @code{t}; any
+start with a capital, e.g., ``use @dots{} instead.''); @code{t}; any
other symbol, which should be an alternative function to use in Lisp
code.
@end defun
@menu
-* Keyboard Events:: Ordinary characters--keys with symbols on them.
-* Function Keys:: Function keys--keys with names, not symbols.
+* 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.
@code{(@var{col} . @var{row})}. The values are the actual row and
column numbers in the window given by @var{position}. @xref{Click
Events}, for details. The function returns @code{nil} if
-@var{position} does not include actual position values.
+@var{position} does not include actual position values; in that case
+@code{posn-col-row} can be used to get approximate values.
+
+Note that this function doesn't account for the visual width of
+characters on display, like the number of visual columns taken by a
+tab character or an image. If you need the coordinates in canonical
+character units, use @code{posn-col-row} instead.
@end defun
@defun posn-string position
@defun posn-object-x-y position
Return the pixel-based x and y coordinates relative to the upper left
corner of the object in @var{position} as a cons cell @code{(@var{dx}
-. @var{dy})}. If the @var{position} is a buffer position, return the
-relative position in the character at that position.
+. @var{dy})}. If the @var{position} is on buffer text, return the
+relative position of the buffer-text character closest to that
+position.
@end defun
@defun posn-object-width-height position
Events read from this list are not normally added to the current
command's key sequence (as returned by, e.g., @code{this-command-keys}),
as the events will already have been added once as they were read for
-the first time. An element of the form @code{(@code{t} . @var{event})}
+the first time. An element of the form @w{@code{(t . @var{event})}}
forces @var{event} to be added to the current command's key sequence.
@end defvar
* Conditionals:: @code{if}, @code{cond}, @code{when}, @code{unless}.
* Combining Conditions:: @code{and}, @code{or}, @code{not}.
* Iteration:: @code{while} loops.
+* Generators:: Generic sequences and coroutines.
* Nonlocal Exits:: Jumping out of a sequence.
@end menu
@end example
@end defmac
+@node Generators
+@section Generators
+@cindex generators
+
+ A @dfn{generator} is a function that produces a potentially-infinite
+stream of values. Each time the function produces a value, it
+suspends itself and waits for a caller to request the next value.
+
+@defmac iter-defun name args [doc] [declare] [interactive] body@dots{}
+@code{iter-defun} defines a generator function. A generator function
+has the same signature as a normal function, but works differently.
+Instead of executing @var{body} when called, a generator function
+returns an iterator object. That iterator runs @var{body} to generate
+values, emitting a value and pausing where @code{iter-yield} or
+@code{iter-yield-from} appears. When @var{body} returns normally,
+@code{iter-next} signals @code{iter-end-of-sequence} with @var{body}'s
+result as its condition data.
+
+Any kind of Lisp code is valid inside @var{body}, but
+@code{iter-yield} and @code{iter-yield-from} cannot appear inside
+@code{unwind-protect} forms.
+
+@end defmac
+
+@defmac iter-lambda args [doc] [interactive] body@dots{}
+@code{iter-lambda} produces an unnamed generator function that works
+just like a generator function produced with @code{iter-defun}.
+@end defmac
+
+@defmac iter-yield value
+When it appears inside a generator function, @code{iter-yield}
+indicates that the current iterator should pause and return
+@var{value} from @code{iter-next}. @code{iter-yield} evaluates to the
+@code{value} parameter of next call to @code{iter-next}.
+@end defmac
+
+@defmac iter-yield-from iterator
+@code{iter-yield-from} yields all the values that @var{iterator}
+produces and evaluates to the value that @var{iterator}'s generator
+function returns normally. While it has control, @var{iterator}
+receives values sent to the iterator using @code{iter-next}.
+@end defmac
+
+ To use a generator function, first call it normally, producing a
+@dfn{iterator} object. An iterator is a specific instance of a
+generator. Then use @code{iter-next} to retrieve values from this
+iterator. When there are no more values to pull from an iterator,
+@code{iter-next} raises an @code{iter-end-of-sequence} condition with
+the iterator's final value.
+
+It's important to note that generator function bodies only execute
+inside calls to @code{iter-next}. A call to a function defined with
+@code{iter-defun} produces an iterator; you must ``drive'' this
+iterator with @code{iter-next} for anything interesting to happen.
+Each call to a generator function produces a @emph{different}
+iterator, each with its own state.
+
+@defun iter-next iterator value
+Retrieve the next value from @var{iterator}. If there are no more
+values to be generated (because @var{iterator}'s generator function
+returned), @code{iter-next} signals the @code{iter-end-of-sequence}
+condition; the data value associated with this condition is the value
+with which @var{iterator}'s generator function returned.
+
+@var{value} is sent into the iterator and becomes the value to which
+@code{iter-yield} evaluates. @var{value} is ignored for the first
+@code{iter-next} call to a given iterator, since at the start of
+@var{iterator}'s generator function, the generator function is not
+evaluating any @code{iter-yield} form.
+@end defun
+
+@defun iter-close iterator
+If @var{iterator} is suspended inside an @code{unwind-protect}'s
+@code{bodyform} and becomes unreachable, Emacs will eventually run
+unwind handlers after a garbage collection pass. (Note that
+@code{iter-yield} is illegal inside an @code{unwind-protect}'s
+@code{unwindforms}.) To ensure that these handlers are run before
+then, use @code{iter-close}.
+@end defun
+
+Some convenience functions are provided to make working with
+iterators easier:
+
+@defmac iter-do (var iterator) body @dots{}
+Run @var{body} with @var{var} bound to each value that
+@var{iterator} produces.
+@end defmac
+
+The Common Lisp loop facility also contains features for working with
+iterators. See @xref{Loop Facility,,,cl,Common Lisp Extensions}.
+
+The following piece of code demonstrates some important principles of
+working with iterators.
+
+@example
+(iter-defun my-iter (x)
+ (iter-yield (1+ (iter-yield (1+ x))))
+ ;; Return normally
+ -1)
+
+(let* ((iter (my-iter 5))
+ (iter2 (my-iter 0)))
+ ;; Prints 6
+ (print (iter-next iter))
+ ;; Prints 9
+ (print (iter-next iter 8))
+ ;; Prints 1; iter and iter2 have distinct states
+ (print (iter-next iter2 nil))
+
+ ;; We expect the iter sequence to end now
+ (condition-case x
+ (iter-next iter)
+ (iter-end-of-sequence
+ ;; Prints -1, which my-iter returned normally
+ (print (cdr x)))))
+@end example
+
@node Nonlocal Exits
@section Nonlocal Exits
@cindex nonlocal exits
Alternative foreground color, a string. This is like @code{:foreground}
but the color is only used as a foreground when the background color is
near to the foreground that would have been used. This is useful for
-example when marking text (i.e. the region face). If the text has a foreground
+example when marking text (i.e., the region face). If the text has a foreground
that is visible with the region face, that foreground is used.
If the foreground is near the region face background,
@code{:distant-foreground} is used instead so the text is readable.
This variable holds the value of @code{window-system} used for the
first frame created by Emacs during startup. (When Emacs is invoked
with the @option{--daemon} option, it does not create any initial
-frames, so @code{initial-window-system} is @code{nil}. @xref{Initial
-Options, daemon,, emacs, The GNU Emacs Manual}.)
+frames, so @code{initial-window-system} is @code{nil}, except on
+MS-Windows, where it is still @code{w32}. @xref{Initial Options,
+daemon,, emacs, The GNU Emacs Manual}.)
@end defvar
@defun window-system &optional frame
* Byte-Code Type:: A function written in Lisp, then compiled.
* Autoload Type:: A type used for automatically loading seldom-used
functions.
+* Finalizer Type:: Runs code when no longer reachable.
Character Type
* Conditionals:: @code{if}, @code{cond}, @code{when}, @code{unless}.
* Combining Conditions:: @code{and}, @code{or}, @code{not}.
* Iteration:: @code{while} loops.
+* Generators:: Generic sequences and coroutines.
* Nonlocal Exits:: Jumping out of a sequence.
Nonlocal Exits
Input Events
-* Keyboard Events:: Ordinary characters--keys with symbols on them.
-* Function Keys:: Function keys--keys with names, not symbols.
+* 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.
Position of the top-left corner and size of the work area (``usable''
space) in pixels as @samp{(@var{x} @var{y} @var{width} @var{height})}.
This may be different from @samp{geometry} in that space occupied by
-various window manager features (docks, taskbars, etc.) may be
+various window manager features (docks, taskbars, etc.)@: may be
excluded from the work area. Whether or not such features actually
subtract from the work area depends on the platform and environment.
Again, if the monitor is not the primary monitor, some of the
@code{nil}.
@end table
+
@node Size Parameters
@subsubsection Size Parameters
@cindex window size on display
@vindex fullscreen, a frame parameter
@item fullscreen
Specify that width, height or both shall be maximized. The value
-@code{fullwidth} specifies that width shall be as wide as possible.
-The value @code{fullheight} specifies that height shall be as tall as
+@code{fullwidth} specifies that width shall be as wide as possible. The
+value @code{fullheight} specifies that height shall be as tall as
possible. The value @code{fullboth} specifies that both the width and
the height shall be set to the size of the screen. The value
-@code{maximized} specifies that the frame shall be maximized. The
-difference between @code{maximized} and @code{fullboth} is that the
-former can still be resized by dragging window manager decorations
-with the mouse, while the latter really covers the whole screen and
-does not allow resizing by mouse dragging.
+@code{maximized} specifies that the frame shall be maximized.
+
+The difference between @code{maximized} and @code{fullboth} is that a
+maximized frame usually keeps its title bar and the buttons for resizing
+and closing the frame. Also, maximized frames typically avoid hiding
+any task bar or panels displayed on the desktop. ``Fullboth'' frames,
+on the other hand, usually omit the title bar and occupy the entire
+available screen space.
+
+``Fullheight'' and ``fullwidth'' frames are more similar to maximized
+frames in this regard. However, these typically display an external
+border which might be absent with maximized frames. Hence the heights
+of maximized and fullheight frames and the widths of maximized and
+fullwidth frames often differ by a few pixels.
With some window managers you may have to customize the variable
-@code{frame-resize-pixelwise} (@pxref{Size and Position}) to a
-non-@code{nil} value in order to make a frame appear ``maximized'' or
-``fullscreen''.
+@code{frame-resize-pixelwise} (@pxref{Size and Position}) in order to
+make a frame truly appear ``maximized'' or ``fullscreen''. Moreover,
+some window managers might not support smooth transition between the
+various fullscreen or maximization states. Customizing the variable
+@code{x-frame-normalize-before-maximize} can help to overcome that.
+
+@vindex fullscreen-restore, a frame parameter
+@item fullscreen-restore
+This parameter specifies the desired ``fullscreen'' state of the frame
+after invoking the @code{toggle-frame-fullscreen} command (@pxref{Frame
+Commands,,, emacs, The GNU Emacs Manual}) in the ``fullboth'' state.
+Normally this parameter is installed automatically by that command when
+toggling the state to fullboth. If, however, you start Emacs in the
+fullboth state, you have to specify the desired behavior in your initial
+file as, for example
+
+@example
+(setq default-frame-alist
+ '((fullscreen . fullboth) (fullscreen-restore . fullheight)))
+@end example
+
+This will give a new frame full height after typing in it @key{F11} for
+the first time.
@end table
+
@node Layout Parameters
@subsubsection Layout Parameters
@cindex layout parameters of frames
@var{frame}, measured in pixels. Together, these values establish the
size of the default font on @var{frame}. The values depend on the
choice of font for @var{frame}, see @ref{Font and Color Parameters}.
-@end defun
+@end defun
The default font can be also set directly with the following function:
stored in @var{place} (@pxref{Generalized Variables}).
@var{where} determines how @var{function} is composed with the
-existing function, e.g. whether @var{function} should be called before, or
+existing function, e.g., whether @var{function} should be called before, or
after the original function. @xref{Advice combinators}, for the list of
available ways to compose the two functions.
@defun advice-eval-interactive-spec spec
Evaluate the interactive @var{spec} just like an interactive call to a function
with such a spec would, and then return the corresponding list of arguments
-that was built. E.g. @code{(advice-eval-interactive-spec "r\nP")} will
+that was built. E.g., @code{(advice-eval-interactive-spec "r\nP")} will
return a list of three elements, containing the boundaries of the region and
the current prefix argument.
@end defun
of @code{intptr_t}).
@item
-Prefer @code{int} for Emacs character codes, in the range 0 ..@: 0x3FFFFF.
+Prefer @code{int} for Emacs character codes, in the range 0 ..@: 0x3FFFFF@.
More generally, prefer @code{int} for integers known to be in
@code{int} range, e.g., screen column counts.
If the option @code{load-prefer-newer} is non-@code{nil}, then when
searching suffixes, @code{load} selects whichever version of a file
-(@samp{.elc}, @samp{.el}, etc.) has been modified most recently.
+(@samp{.elc}, @samp{.el}, etc.)@: has been modified most recently.
If @var{filename} is a relative file name, such as @file{foo} or
@file{baz/foo.bar}, @code{load} searches for the file using the variable
When Emacs is running in batch mode, any request to read from the
minibuffer actually reads a line from the standard input descriptor that
was supplied when Emacs was started. This supports only basic input:
-none of the special minibuffer features (history, completion, etc.)
+none of the special minibuffer features (history, completion, etc.)@:
are available in batch mode.
@node Text from Minibuffer
@code{t}. Otherwise, it returns the longest initial sequence common
to all possible matching completions.
-If @var{collection} is an list, the permissible completions are
+If @var{collection} is a list, the permissible completions are
specified by the elements of the list, each of which should be either
a string, or a cons cell whose @sc{car} is either a string or a symbol
(a symbol is converted to a string using @code{symbol-name}). If the
@math{x = s 2^e}.
@end tex
If @var{x} is zero or infinity, then @var{s} is the same as @var{x}.
-If @var{x} is a NaN, then @var{s} is also a NaN.
+If @var{x} is a NaN, then @var{s} is also a NaN@.
If @var{x} is zero, then @var{e} is 0.
@end defun
-@defun ldexp sig &optional exp
-This function returns a floating-point number corresponding to the
-significand @var{sig} and exponent @var{exp}.
+@defun ldexp s e
+Given a numeric significand @var{s} and an integer exponent @var{e},
+this function returns the floating point number
+@ifnottex
+@var{s} * 2**@var{e}.
+@end ifnottex
+@tex
+@math{s 2^e}.
+@end tex
@end defun
@defun copysign x1 x2
* Byte-Code Type:: A function written in Lisp, then compiled.
* Autoload Type:: A type used for automatically loading seldom-used
functions.
+* Finalizer Type:: Runs code when no longer reachable.
+
@end menu
@node Integer Type
@code{autoload}, which stores the object in the function cell of a
symbol. @xref{Autoload}, for more details.
+@node Finalizer Type
+@subsection Finalizer Type
+
+ A @dfn{finalizer object} helps Lisp code clean up after objects that
+are no longer needed. A finalizer holds a Lisp function object.
+When a finalizer object becomes unreachable after a garbage collection
+pass, Emacs calls the finalizer's associated function object.
+When deciding whether a finalizer is reachable, Emacs does not count
+references from finalizer objects themselves, allowing you to use
+finalizers without having to worry about accidentally capturing
+references to finalized objects themselves.
+
+Errors in finalizers are printed to @code{*Messages*}. Emacs runs
+a given finalizer object's associated function exactly once, even
+if that function fails.
+
+@defun make-finalizer function
+Make a finalizer that will run @var{function}. @var{function} will be
+called after garbage collection when the returned finalizer object
+becomes unreachable. If the finalizer object is reachable only
+through references from finalizer objects, it does not count as
+reachable for the purpose of deciding whether to run @var{function}.
+@var{function} will be run once per finalizer object.
+@end defun
+
@node Editing Types
@section Editing Types
@cindex editing types
This function returns a symbol naming the primitive type of
@var{object}. The value is one of the symbols @code{bool-vector},
@code{buffer}, @code{char-table}, @code{compiled-function},
-@code{cons}, @code{float}, @code{font-entity}, @code{font-object},
-@code{font-spec}, @code{frame}, @code{hash-table}, @code{integer},
-@code{marker}, @code{overlay}, @code{process}, @code{string},
-@code{subr}, @code{symbol}, @code{vector}, @code{window}, or
-@code{window-configuration}.
+@code{cons}, @code{finalizer}, @code{float}, @code{font-entity},
+@code{font-object}, @code{font-spec}, @code{frame}, @code{hash-table},
+@code{integer}, @code{marker}, @code{overlay}, @code{process},
+@code{string}, @code{subr}, @code{symbol}, @code{vector},
+@code{window}, or @code{window-configuration}.
@example
(type-of 1)
@example
@group
-(equal "asdf" (propertize "asdf" '(asdf t)))
+(equal "asdf" (propertize "asdf" 'asdf t))
@result{} t
@end group
@group
(equal-including-properties "asdf"
- (propertize "asdf" '(asdf t)))
+ (propertize "asdf" 'asdf t))
@result{} nil
@end group
@end example
@item
If the option @code{--daemon} was specified, it calls
-@code{server-start} and detaches from the controlling terminal.
-@xref{Emacs Server,,, emacs, The GNU Emacs Manual}.
+@code{server-start}, and on Posix systems also detaches from the
+controlling terminal. @xref{Emacs Server,,, emacs, The GNU Emacs
+Manual}.
@item
If started by the X session manager, it calls
improve the performance of your code. @xref{Truncation, cache-long-scans}.
@end ignore
-@defun vertical-motion count &optional window
+@defun vertical-motion count &optional window cur-col
This function moves point to the start of the screen line @var{count}
screen lines down from the screen line containing point. If @var{count}
is negative, it moves up instead.
width, the horizontal scrolling, and the display table. But
@code{vertical-motion} always operates on the current buffer, even if
@var{window} currently displays some other buffer.
+
+The optional argument @var{cur-col} specifies the current column when
+the function is called. This is the window-relative horizontal
+coordinate of point, measured in units of font width of the frame's
+default face. Providing it speeds up the function, especially in very
+long lines, because it doesn't have to go back in the buffer in order
+to determine the current column. Note that @var{cur-col} is also
+counted from the visual start of the line.
@end defun
@defun count-screen-lines &optional beg end count-final-newline window
It is often useful to move point ``temporarily'' within a localized
portion of the program. This is called an @dfn{excursion}, and it is
done with the @code{save-excursion} special form. This construct
-remembers the initial identity of the current buffer, and its values
-of point and the mark, and restores them after the excursion
+remembers the initial identity of the current buffer, and its value
+of point, and restores them after the excursion
completes. It is the standard way to move point within one part of a
program and avoid affecting the rest of the program, and is used
thousands of times in the Lisp sources of Emacs.
@cindex mark excursion
@cindex point excursion
This special form saves the identity of the current buffer and the
-values of point and the mark in it, evaluates @var{body}, and finally
-restores the buffer and its saved values of point and the mark. All
-three saved values are restored even in case of an abnormal exit via
+value of point in it, evaluates @var{body}, and finally
+restores the buffer and its saved value of point. both saved values are
+restored even in case of an abnormal exit via
@code{throw} or error (@pxref{Nonlocal Exits}).
The value returned by @code{save-excursion} is the result of the last
form in @var{body}, or @code{nil} if no body forms were given.
@end defspec
- Because @code{save-excursion} only saves point and mark for the
+ Because @code{save-excursion} only saves point for the
buffer that was current at the start of the excursion, any changes
-made to point and/or mark in other buffers, during the excursion, will
+made to point in other buffers, during the excursion, will
remain in effect afterward. This frequently leads to unintended
consequences, so the byte compiler warns if you call @code{set-buffer}
during an excursion:
saved point value is restored, it normally comes before the inserted
text.
- Although @code{save-excursion} saves the location of the mark, it does
-not prevent functions which modify the buffer from setting
-@code{deactivate-mark}, and thus causing the deactivation of the mark
-after the command finishes. @xref{The Mark}.
-
@node Narrowing
@section Narrowing
@cindex narrowing
restrictions it saved from), but it does not restore the identity of the
current buffer.
-@code{save-restriction} does @emph{not} restore point and the mark; use
+@code{save-restriction} does @emph{not} restore point; use
@code{save-excursion} for that. If you use both @code{save-restriction}
and @code{save-excursion} together, @code{save-excursion} should come
first (on the outside). Otherwise, the old point value would be
@c It actually uses shell-command-switch, but no need to mention that here.
@end defun
-@defun call-process-shell-command command &optional infile destination display &rest args
+@defun call-process-shell-command command &optional infile destination display
This function executes the shell command @var{command} synchronously.
-The final arguments @var{args} are additional arguments to add at the
-end of @var{command}. The other arguments are handled as in
-@code{call-process}.
+The arguments are handled as in @code{call-process}. An old calling
+convention allowed to pass any number of additional arguments after
+@var{display}, which were concatenated to @var{command}; this is still
+supported, but strongly discouraged.
@end defun
-@defun process-file-shell-command command &optional infile destination display &rest args
+@defun process-file-shell-command command &optional infile destination display
This function is like @code{call-process-shell-command}, but uses
@code{process-file} internally. Depending on @code{default-directory},
-@var{command} can be executed also on remote hosts.
+@var{command} can be executed also on remote hosts. An old calling
+convention allowed to pass any number of additional arguments after
+@var{display}, which were concatenated to @var{command}; this is still
+supported, but strongly discouraged.
@end defun
@defun shell-command-to-string command
Information}).
@end defvar
+@defun make-process &rest args
+This function is like @code{start-process}, but takes keyword arguments.
+
+The arguments @var{args} are a list of keyword/argument pairs.
+Omitting a keyword is always equivalent to specifying it with value
+@code{nil}. Here are the meaningful keywords:
+
+@table @asis
+@item :name @var{name}
+Use the string @var{name} as the process name. It is modified if
+necessary to make it unique.
+
+@item :buffer @var{buffer}
+Use @var{buffer} as the process buffer.
+
+@item :command @var{command}
+Use @var{command} as the command line of the process. @var{command}
+is a list starting with the program's executable file name, followed
+by strings to give to program as arguments.
+
+@item :coding @var{coding}
+If @var{coding} is a symbol, it specifies the coding system to be
+used for both reading and writing of data from and to the
+connection. If @var{coding} is a cons cell
+@w{@code{(@var{decoding} . @var{encoding})}}, then @var{decoding}
+will be used for reading and @var{encoding} for writing.
+
+If @var{coding} is @code{nil}, the default rules for finding the
+coding system will apply. @xref{Default Coding Systems}.
+
+@item :connection-type @var{TYPE}
+Initialize the type of device used to communicate with the subprocess.
+Possible values are @code{pty} to use a pty, @code{pipe} to use a
+pipe, or @code{nil} to use the default derived from the value of
+the @code{process-connection-type} variable.
+
+@item :noquery @var{query-flag}
+Initialize the process query flag to @var{query-flag}.
+@xref{Query Before Exit}.
+
+@item :stop @var{stopped}
+If @var{stopped} is non-@code{nil}, start the process in the
+``stopped'' state.
+
+@item :filter @var{filter}
+Initialize the process filter to @var{filter}.
+
+@item :sentinel @var{sentinel}
+Initialize the process sentinel to @var{sentinel}.
+@end table
+
+The original argument list, modified with the actual connection
+information, is available via the @code{process-contact} function.
+@end defun
+
@node Deleting Processes
@section Deleting Processes
@cindex deleting processes
@item [:ascii:]
This matches any @acronym{ASCII} character (codes 0--127).
@item [:alnum:]
-This matches any letter or digit. (At present, for multibyte
-characters, it matches anything that has word syntax.)
+This matches any letter or digit. For multibyte characters, it
+matches characters whose Unicode @samp{general-category} property
+(@pxref{Character Properties}) indicates they are alphabetic or
+decimal number characters.
@item [:alpha:]
-This matches any letter. (At present, for multibyte characters, it
-matches anything that has word syntax.)
+This matches any letter. For multibyte characters, it matches
+characters whose Unicode @samp{general-category} property
+(@pxref{Character Properties}) indicates they are alphabetic
+characters.
@item [:blank:]
This matches space and tab only.
@item [:cntrl:]
@end example
@end defun
+@defun seq-mapcat function sequence &optional type
+ This function returns the result of applying @code{seq-concatenate}
+to the result of applying @var{function} to each element of
+@var{sequence}. The result is a sequence of type @var{type}, or a
+list if @var{type} is @code{nil}.
+
+@example
+@group
+(seq-mapcat #'seq-reverse '((3 2 1) (6 5 4)))
+@result{} (1 2 3 4 5 6)
+@end group
+@end example
+@end defun
+
+@defun seq-partition sequence n
+ This function returns a list of the elements of @var{sequence}
+grouped into sub-sequences of length @var{n}. The last sequence may
+contain less elements than @var{n}. @var{n} must be an integer. If
+@var{n} is a negative integer or 0, nil is returned.
+
+@example
+@group
+(seq-partition '(0 1 2 3 4 5 6 7) 3)
+@result{} ((0 1 2) (3 4 5) (6 7))
+@end group
+@end example
+@end defun
+
+@defun seq-group-by function sequence
+ This function separates the elements of @var{sequence} into an alist
+whose keys are the result of applying @var{function} to each element
+of @var{sequence}. Keys are compared using @code{equal}.
+
+@example
+@group
+(seq-group-by #'integerp '(1 2.1 3 2 3.2))
+@result{} ((t 1 3 2) (nil 2.1 3.2))
+@end group
+@group
+(seq-group-by #'car '((a 1) (b 2) (a 3) (c 4)))
+@result{} ((b (b 2)) (a (a 1) (a 3)) (c (c 4)))
+@end group
+@end example
+@end defun
+
+@defun seq-into sequence type
+ This function converts the sequence @var{sequence} into a sequence
+of type @var{type}. @var{type} can be one of the following symbols:
+@code{vector}, @code{string} or @code{list}.
+
+@example
+@group
+(seq-into [1 2 3] 'list)
+@result{} (1 2 3)
+@end group
+@group
+(seq-into nil 'vector)
+@result{} []
+@end group
+@group
+(seq-into "hello" 'vector)
+@result{} [104 101 108 108 111]
+@end group
+@end example
+@end defun
+
+
@defmac seq-doseq (var sequence [result]) body@dots{}
@cindex sequence iteration
-This macro is like @code{dolist}, except that @var{sequence} can be a list,
+ This macro is like @code{dolist}, except that @var{sequence} can be a list,
vector or string (@pxref{Iteration} for more information about the
@code{dolist} macro). This is primarily useful for side-effects.
@end defmac
Emacs process in batch mode, it is sometimes required to make sure any
arbitrary binary data will be read/written verbatim, and/or that no
translation of newlines to or from CR-LF pairs are performed. This
-issue does not exist on Posix hosts, only on MS-Windows and MS-DOS.
+issue does not exist on Posix hosts, only on MS-Windows and MS-DOS@.
The following function allows to control the I/O mode of any standard
stream of the Emacs process.
This command deletes whitespace characters after the last
non-whitespace character in each line in the region.
-If this command acts on the entire buffer (i.e. if called
+If this command acts on the entire buffer (i.e., if called
interactively with the mark inactive, or called from Lisp with
@var{end} @code{nil}), it also deletes all trailing lines at the end of the
buffer if the variable @code{delete-trailing-lines} is non-@code{nil}.
@defun get-pos-property position prop &optional object
This function is like @code{get-char-property}, except that it pays
attention to properties' stickiness and overlays' advancement settings
-instead of the property of the character at (i.e. right after)
+instead of the property of the character at (i.e., right after)
@var{position}.
@end defun
+2015-03-25 Glenn Morris <rgm@gnu.org>
+
+ * newsticker.texi (Supported Formats): Remove dead url.
+
+ * remember.texi (Function Reference): Copyedit.
+
+ * idlwave.texi (HTML Help Browser Tips): Remove obsolete info.
+
+2015-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ * efaq-w32.texi: Remove outdated information and update.
+
+2015-03-18 Martin Rudalics <rudalics@gmx.at>
+
+ * efaq.texi (Fullscreen mode on MS-Windows):
+ Fix description (Bug#20110).
+
+2015-03-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * tramp.texi (External methods) <adb>: Explain, when Tramp
+ connects to devices. Mention port numbers.
+ (GVFS based methods, File name completion): Add index.
+ (Multi-hops, Remote Programs, File name completion, Ad-hoc multi-hops):
+ Improve wording.
+
+ * trampver.texi: Update release number.
+
+2015-03-03 Kelvin White <kwhite@gnu.org>
+
+ * erc.texi (Advanced Usage, Options): Add descriptions and examples
+ for erc-format-nick-function and erc-rename-buffers options.
+ (Connecting): Fix typo
+
+2015-03-02 Daniel Colascione <dancol@dancol.org>
+
+ * cl.texi (Iteration Clauses): Mention iterator support.
+
+2015-02-25 Tassilo Horn <tsdh@gnu.org>
+
+ * reftex.texi (Multifile Documents): Document
+ reftex-include-file-commands.
+ (Options): Mention that non-customize changes might require
+ calling reftex-compile-variables.
+
+2015-02-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ * texinfo.tex: Update from gnulib.
+
+2015-02-10 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * eww.texi (Basics): Mention eww-toggle-fonts.
+
+2015-02-05 Glenn Morris <rgm@gnu.org>
+
+ * auth.texi (Multiple GMail accounts with Gnus): Markup fix.
+
+2015-02-05 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * auth.texi (Multiple GMail accounts with Gnus): Add FAQ.
+
+2015-02-05 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Using IMAP): Fix menu node name.
+
+2015-02-05 Trevor Murphy <trevor.m.murphy@gmail.com>
+
+ * gnus.texi (Support for IMAP Extensions): Document the Gmail label
+ extension.
+
+2015-02-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * texinfo.tex: Update from gnulib.
+
2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
* eudc.texi (LDAP Configuration): Rename from LDAP Requirements
@menu
* Overview:: Overview of the auth-source library.
* Help for users::
+* Multiple GMail accounts with Gnus::
* Secret Service API::
* Help for developers::
* GnuPG and EasyPG Assistant Configuration::
token with either single or double quotes.
You can use single quotes inside a password or other token by
-surrounding it with double quotes, e.g. @code{"he'llo"}. Similarly you
+surrounding it with double quotes, e.g., @code{"he'llo"}. Similarly you
can use double quotes inside a password or other token by surrounding
-it with single quotes, e.g. @code{'he"llo'}. You can't mix both (so a
+it with single quotes, e.g., @code{'he"llo'}. You can't mix both (so a
password or other token can't have both single and double quotes).
All this is optional. You could just say (but we don't recommend it,
earlier. Since Tramp has about 88 connection methods, this may be
necessary if you have an unusual (see earlier comment on those) setup.
+@node Multiple GMail accounts with Gnus
+@chapter Multiple GMail accounts with Gnus
+
+For multiple GMail accounts with Gnus, you have to make two nnimap
+entries in your @code{gnus-secondary-select-methods} with distinct
+names:
+
+@example
+(setq gnus-secondary-select-methods '((nnimap "gmail"
+ (nnimap-address "imap.gmail.com"))
+ (nnimap "gmail2"
+ (nnimap-address "imap.gmail.com"))))
+@end example
+
+Your netrc entries will then be:
+
+@example
+machine gmail login account@@gmail.com password "account password" port imap
+machine gmail2 login account2@@gmail.com password "account2 password" port imap
+@end example
+
@node Secret Service API
@chapter Secret Service API
or with @kbd{$} to take a formula from the top of the stack, or with
@kbd{'} and a typed formula. In the last two cases, the formula may
be a nameless function like @samp{<#1+#2>} or @samp{<x, y : x+y>}, or it
-may include @kbd{$}, @kbd{$$}, etc. (where @kbd{$} will correspond to the
+may include @kbd{$}, @kbd{$$}, etc.@: (where @kbd{$} will correspond to the
last argument of the created function), or otherwise you will be
prompted for an argument list. The number of vectors popped from the
stack by @kbd{V M} depends on the number of arguments of the function.
Since there's a lot of normal text in comments and string literals,
@ccmode{} provides features to edit these like in text mode. The goal
is to do it seamlessly, i.e., you can use auto fill mode, sentence and
-paragraph movement, paragraph filling, adaptive filling etc. wherever
+paragraph movement, paragraph filling, adaptive filling etc.@: wherever
there's a piece of normal text without having to think much about it.
@ccmode{} keeps the indentation, fixes suitable comment line prefixes,
and so on.
Due to release schedule skew, it is likely that all of these Emacsen
have old versions of @ccmode{} and so should be upgraded. Access to the
@ccmode{} source code, as well as more detailed information on Emacsen
-compatibility, etc. are all available on the web site:
+compatibility, etc.@: are all available on the web site:
@quotation
@uref{http://cc-mode.sourceforge.net/}
called @var{name}; @pxref{Blocks and Exits}.
@end defmac
+@defmac cl-iter-defun name arglist body@dots{}
+This form is identical to the regular @code{iter-defun} form, except
+that @var{arglist} is allowed to be a full Common Lisp argument
+list. Also, the function body is enclosed in an implicit block
+called @var{name}; @pxref{Blocks and Exits}.
+@end defmac
+
@defmac cl-defsubst name arglist body@dots{}
This is just like @code{cl-defun}, except that the function that
is defined is automatically proclaimed @code{inline}, i.e.,
This clause stops the loop when the specified form is non-@code{nil};
in this case, it returns that non-@code{nil} value. If all the
values were @code{nil}, the loop returns @code{nil}.
+
+@item iter-by @var{iterator}
+This clause iterates over the values from the specified form, an
+iterator object. See (@pxref{Generators,,,elisp,GNU Emacs Lisp
+Reference Manual}).
@end table
@node Accumulation Clauses
@cindex supported versions of Windows
Emacs @value{EMACSVER} is known to run on all versions of Windows from
-@c FIXME does it really still support Windows 98? Does it matter?
-Windows 98 and Windows NT 4.0 through to Windows 7. The Windows port is
-built using the Win32 API and supports most features of the X version,
-including variable width fonts, images and tooltips.
+Windows 98 and Windows NT 4.0 through to Windows 8.1. The Windows
+port is built using the Win32 API and supports most features of the X
+version, including variable width fonts, images and tooltips.
+
+Emacs on Windows can be compiled as either a 32-bit or a 64-bit
+executable, using the MinGW GCC compiler and development tools.
@node Other versions of Emacs
@section What other versions of Emacs run on Windows?
@cindex where to get Emacs binaries
Pre-compiled versions are distributed from
@uref{http://ftpmirror.gnu.org/emacs/windows/, ftp.gnu.org mirrors}.
-Emacs binaries are distributed as zip files, digitally
-signed by the developer who built them. Generally most users will
-want the file @file{emacs-@value{EMACSVER}-bin-i386.zip}, which
-contains everything you need to get started.
+Emacs binaries are distributed as zip files, digitally signed by the
+developer who built them. Generally most users will want the file
+@file{emacs-@value{EMACSVER}-bin-i686-pc-mingw.zip} for the 32-bit
+build, and @file{emacs-@value{EMACSVER}-bin-x86_64-w64-mingw32.zip}
+for the 64-bit build. The zip archive contains everything you need to
+get started.
@cindex where to get sources
@cindex Emacs source code
@section How can I compile Emacs myself?
@cindex compiling Emacs
-To compile Emacs on Windows, you will need the MingW or Cygwin port of
-GCC with MingW make, or a Microsoft C compiler with nmake and the
-single threaded C runtime library. Recent versions of Microsoft
-Visual Studio no longer come with the single threaded C runtime
-library, which is required for certain POSIX compatibility, so MingW
-is usually the best choice. Image support requires external
-libraries, the headers and import libraries for which will need to be
-installed where your compiler can find them. You will also need ports
-of GNU @command{rm} and @command{cp}, as the Windows native
-equivalents are not consistent between versions. GNU texinfo will be
-required to build the manuals. @xref{Other useful ports}.
+To compile Emacs on Windows, you will need the MinGW port of GCC and
+Binutils, the MinGW runtime and development environment, and the MSYS
+suite of tools. For the details, see the file @file{nt/INSTALL} in
+the Emacs source distribution.
+
+Support for displaying images, as well as XML/HTML rendering and TLS
+networking requires external libraries, the headers and import
+libraries for which will need to be installed where your compiler can
+find them. Again, the details, including URLs of sites where you can
+download these libraries are in @file{nt/INSTALL}. @xref{Other useful
+ports}, for auxiliary tools you may wish to install and use in
+conjunction with Emacs.
After unpacking the source, or checking out of the repository, be sure
to read the instructions in @file{nt/README} and @file{nt/INSTALL}.
By default, Emacs is compiled with debugging on, and optimizations enabled.
The optimizations may interfere with some types of debugging; the debugger
may not show clearly where it is, or may not be able to inspect certain
-variables. If this is the case, reconfigure with @option{--no-opt}.
+variables. If this is the case, reconfigure with @kbd{CFLAGS='-O0 -g3'}
The file @file{etc/DEBUG} contains general debugging hints, as well as
-specific notes about debugging Emacs with both gdb and Microsoft debuggers.
-
-@menu
-* GDB::
-* Microsoft Developer Studio::
-@end menu
+specific notes about debugging Emacs.
-@node GDB
-@subsection GDB
-@cindex GDB, debugging Emacs with
@cindex debugging Emacs with GDB
-
GDB is the GNU debugger, which can be used to debug Emacs when it has
-been compiled with GCC. The best results will be obtained if you
-start gdb from the @file{src} directory as @samp{gdb oo/i386/emacs.exe}.
-This will load the init file @file{.gdbinit} in that directory, to
-define some extra commands for working with lisp while debugging, and
-set up breakpoints to catch abnormal aborts.
-
-@node Microsoft Developer Studio
-@subsection Microsoft Developer Studio
-@cindex MSVC++, debugging Emacs with
-@cindex DevStudio, debugging Emacs with
-@cindex debugging Emacs with MS DevStudio
-
-MS DevStudio can be used to debug Emacs when it has been compiled with
-a Microsoft compiler. To view lisp variables, you can call the
-function @code{debug_print} from the Quickwatch window. Some
-@uref{http://www.gnu.org/software/emacs/windows/ntemacs/discuss/debug.txt,
-old tips} are probably still valid.
+been compiled with MinGW GCC. The best results will be obtained if
+you start gdb from the @file{src} directory as @kbd{gdb ./emacs.exe}.
+This will load the init file @file{.gdbinit}@footnote{
+Latest versions of GDB might refuse to load the init file for security
+reasons, unless you customize GDB; alternatively, use an explicit
+@kbd{source ./gdbinit} command after entering GDB.
+} in that directory, to define some extra commands for working with
+lisp while debugging, and set up breakpoints to catch abnormal
+aborts.
+
+A Windows port of GDB can be found on MinGW download sites and on some
+others.
@c ------------------------------------------------------------
@node Installing Emacs
@menu
* Unpacking::
-* Installing::
+* Installing binaries::
* Image support::
* Init file::
* Location of init file::
The binary distributions are distributed as zip files, which are handled
natively by Windows XP and later. For earlier versions, there are many
tools that can handle the zip format, from InfoZip's command line unzip
-tool, to 7zip's multi-format graphical archive explorer. Although
+tool, to 7zip's multi-format graphical archive explorer. (Although
popular, WinZip has caused problems with line-ends in the past, and is not
-Free software, so we do not recommend it.
+Free software, so we do not recommend it.)
-Source distributions are distributed as gzipped tar files. 7zip and
-similar multi-format graphical tools can handle these, or you can get
-Windows ports of the command line gzip and tar tools from multiple sources.
+Source distributions are distributed as @file{.tar.gz} or
+@file{.tar.xz} files. 7zip and similar multi-format graphical tools
+can handle these, or you can get Windows ports of the command line
+gzip and tar tools from multiple sources, or use @command{bsdtar}.
@xref{Other useful ports}.
The command to unpack a source distribution from the command line is:
+
@example
tar xzf emacs-@value{EMACSVER}.tar.gz
@end example
If this does not work with the versions of tar and gzip that you have,
you may need to try a two step process:
+
@example
-gzip -dc emacs-@value{EMACSVER}.tar.gz | tar xvf -
+gzip -dc emacs-@value{EMACSVER}.tar.gz | tar xf -
@end example
You may see many messages from tar complaining about being unable to change
broken pipe. These messages are usually harmless, caused by incomplete ports
that are not fully aware of the limitations of Windows.
-@node Installing
-@section How do I install Emacs after unpacking?
+And here's an example of using @command{bsdtar} (from the
+@samp{libarchive} package) to unpack a @file{.tar.xz} archive:
+
+@example
+bsdtar -xf emacs-@value{EMACSVER}.tar.xz
+@end example
+
+Expect @command{bsdtar} to unpack the whole distribution without any
+complaints.
+
+Once you unpack the source distribution, look in @file{nt/INSTALL}
+file for build instructions.
+
+@node Installing binaries
+@section How do I install Emacs after unpacking the binary zip?
@cindex installing Emacs
@pindex addpm
@cindex Start Menu, creating icons for Emacs
You can run Emacs without any extra steps, but if you want icons in your
Start Menu, or for Emacs to detect the image libraries that are already
installed on your system as part of GTK, then you should run the program
-@file{emacs-@value{EMACSVER}\bin\addpm.exe}.
+@file{addpm.exe}, which is usually installed into the same @file{bin}
+directory with @file{emacs.exe}.
@node Image support
@section How do I get image support?
@cindex gif, installing image support in Emacs
@cindex tiff, installing image support in Emacs
@cindex xpm, installing image support in Emacs
+@cindex rsvg, installing image support in Emacs
@cindex toolbar, installing color icons in
@cindex color images, installing support for images in Emacs
@cindex monochrome images, getting color images in Emacs
Emacs has built in support for XBM and PBM/PGM/PPM images. This is
sufficient to see the monochrome splash screen and tool-bar icons.
-Since 22.2, the official precompiled binaries for Windows have bundled
+Since v22.2, the official precompiled binaries for Windows have bundled
libXpm, which is required to display the color versions of those images.
-Emacs is compiled to recognize JPEG, PNG, GIF and TIFF images also,
-but displaying these image types require external DLLs which are not
-bundled with Emacs. @xref{Other useful ports}.
+Emacs is compiled to recognize JPEG, PNG, GIF, TIFF, and RSVG images
+also, but displaying these image types require external DLLs which are
+not bundled with Emacs. @xref{Other useful ports}.
@node Init file
@section What is my init file?
When Emacs starts up, it attempts to load and execute the contents of
a file commonly called @file{.emacs} (though it may have other names,
-@pxref{Installing Emacs,,Where do I put my init file?}) which contains any
-customizations you have made. You can manually add lisp code to your
-.emacs, or you can use the Customization interface accessible from the
-@emph{Options} menu. If the file does not exist, Emacs will start
-with the default settings.
+@pxref{Location of init file,,Where do I put my init file?}) which
+contains any customizations you have made. You can manually add lisp
+code to your .emacs, or you can use the Customization interface
+accessible from the @emph{Options} menu. If the file does not exist,
+Emacs will start with the default settings.
@node Location of init file
@section Where do I put my init file?
@cindex init.el
@cindex registry, setting the HOME directory in
-On Windows, the .emacs file may be called _emacs for backward
-compatibility with DOS and FAT filesystems where filenames could not
-start with a dot. Some users prefer to continue using such a name,
-because Explorer cannot create a file with a name starting with a dot,
-even though the filesystem and most other programs can handle it.
-In Emacs 22 and later, the init file may also be called
-@file{.emacs.d/init.el}. Many of the other files that are created
-by lisp packages are now stored in the @file{.emacs.d} directory too,
-so this keeps all your Emacs related files in one place.
+On Windows, the @file{.emacs} file may be called @file{_emacs} for
+backward compatibility with DOS and FAT filesystems where filenames
+could not start with a dot. Some users prefer to continue using such
+a name due to historical problems various Windows tools had in the
+past with file names that begin with a dot. In Emacs 22 and later,
+the init file may also be called @file{.emacs.d/init.el}. Many of the
+other files that are created by lisp packages are now stored in the
+@file{.emacs.d} directory too, so this keeps all your Emacs related
+files in one place.
All the files mentioned above should go in your @env{HOME} directory.
The @env{HOME} directory is determined by following the steps below:
if @env{HOME} was not set.
@item
Use the user's AppData directory, usually a directory called
-@file{Application Data} under the user's profile directory, the location
+@file{AppData} under the user's profile directory, the location
of which varies according to Windows version and whether the computer is
part of a domain.
@end enumerate
Within Emacs, @key{~} at the beginning of a file name is expanded to your
-@env{HOME} directory, so you can always find your .emacs file with
-@kbd{C-x C-f ~/.emacs}.
+@env{HOME} directory, so you can always find your @file{.emacs} file
+by typing the command @kbd{C-x C-f ~/.emacs}.
@node Troubleshooting init file
@section Troubleshooting init file problems
@file{*scratch*} buffer using @kbd{C-x C-e}:
@example
-(insert (getenv "HOME"))
+(getenv "HOME")
@end example
-Look carefully at what is printed and make sure the value is
-valid. For example, if the value has trailing whitespace, Emacs won't
-be able to find the directory. Also, be sure that the value isn't a
-relative drive letter (e.g., @file{d:} without a backslash); if it is,
-then @env{HOME} is going to be whatever the current directory on that
-drive is, which is likely not what you want to happen.
+Look carefully at what is printed in the echo area, and make sure the
+value is valid. For example, if the value has trailing whitespace,
+Emacs won't be able to find the directory. Also, be sure that the
+value isn't a relative drive letter (e.g., @file{d:} without a
+backslash or a forward slash after the colon); if it is, then
+@env{HOME} is going to be whatever the current directory on that drive
+is, which is likely not what you want to happen.
@node Associate files with Emacs
@section How do I associate files with Emacs?
The location of the Desktop varies between different versions of
Windows, and in a corporate environment can be moved around by the
-network administrator. On NT derivatives, you can use the value of
-the @env{USERPROFILE} environment variable to find where the desktop
-might be:
+network administrator. On latest Windows versions, you can use the
+value of the @env{USERPROFILE} environment variable to find where the
+desktop might be:
@example
@kbd{C-x C-f $USERPROFILE/Desktop}
@end menu
@node Focus follows mouse
-@subsection How do it make the active window follow the mouse?
+@subsection How do I make the active window follow the mouse?
@vindex focus-follows-mouse
@cindex point to focus
@cindex mouse over to focus
software available to change that though). The latter can be used to
make Emacs use a focus-follow-mouse policy within its own frames.
+You can also change the Windows click-to-focus policy by changing
+settings in the Registry. The details vary according to your Windows
+version; look on the Internet for instructions to enable ``active
+window tracking'' for your version of Windows.
+
@node Swap CapsLock and Control
@subsection How do I swap CapsLock and Control?
@cindex scan codes, modifying
Message-ID: <fawg21mm4hm.fsf@@mordor.rsn.hp.com>
Subject: Re: Re[2]: problem with caps/ctrl swap on NT 4.0
@end ignore
-@example
+@smallexample
It's a binary value that lets you map keystrokes in the low-level keyboard
drivers in NT. As a result you don't have to worry about applications
bypassing mappings that you've done at a higher level (i.e. it just works).
This registry value is system wide, and can't be made user-specific. It
also only takes affect on reboot.
-@end example
+@end smallexample
@item
Ulfar Erlingsson has provided a registry file that sets the CapsLock key
to be a Control key and the Windows key to be an Alt key:
to be reactivated to operate on it, unless @code{mark-even-if-inactive}
is set. Secondly, @code{transient-mark-mode} also highlights the
region when it is active, providing the same visual clue that you get
-in other programs.
+in other programs. This mode is turned on by default in latest
+versions of Emacs.
In addition to seeing the highlighting, new Emacs users often expect
editing commands to replace the region when it is active. This behavior
@cindex delete Emacs directory
Emacs does not come with an uninstall program. No files are installed
-outside of the Emacs base directory, so deleting that directory is
-sufficient to clean away the files. If you ran @command{addpm},
-you'll need to delete the Start Menu group too. The registry entries
-inserted by @command{addpm} will not cause any problems if you leave
-them there, but for the sake of completeness, you can use @command{regedit}
-to remove the keys under @code{HKEY_LOCAL_MACHINE} orx
-@code{HKEY_CURRENT_USER}: @code{SOFTWARE\GNU\Emacs}, and the key
-@code{HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\emacs.exe} if it exists.
+outside of the directories you find in the binary zip archive, so
+deleting those directories is sufficient to clean away the files. If
+you ran @command{addpm}, you'll need to delete the Start Menu group
+too. The registry entries inserted by @command{addpm} will not cause
+any problems if you leave them there, but for the sake of
+completeness, you can use @command{regedit} to remove the keys under
+@code{HKEY_LOCAL_MACHINE} or @code{HKEY_CURRENT_USER}:
+@code{SOFTWARE\GNU\Emacs}, and the key
+@code{HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App
+Paths\emacs.exe} if it exists.
@node Does not run
@section When I run Emacs nothing happens
corrupted while unpacking and Emacs will not start.
@end enumerate
-If it is still not working, send mail to the list, describing what
-you've done, and what you are seeing. (The more information you send
-the more likely it is that you'll receive a helpful response..
+If it is still not working, send mail to the
+@email{help-gnu-emacs@@gnu.org} mailing list, describing what you've
+done, and what you are seeing. (The more information you send the more
+likely it is that you'll receive a helpful response.)
@node Virus
@section Does Emacs contain a virus?
* Font names::
* Bold and italic::
* Multilingual fonts::
-* BDF fonts::
* Font menu::
* Line ends::
@end menu
based when fonts are listed, which may let you differentiate between two
fonts with the same name and different technologies.
-From Emacs 23, the preferred font name format will be moving to the simpler
-and more flexible fontconfig format. XLFD names will continue to be
-supported for backward compatibility.
+Starting with Emacs 23, the preferred font name format will be moving
+to the simpler and more flexible fontconfig format. XLFD names will
+continue to be supported for backward compatibility.
@example
XLFD: -*-Courier New-normal-r-*-*-13-*-*-*-c-*-iso8859-1
(set-face-font 'bold-italic "-*-Courier New-bold-i-*-*-11-*-*-*-c-*-iso8859-1")
@end example
+The @code{w32-enable-synthesized-fonts} variable is obsolete starting
+from Emacs 24.4, as Emacs no longer has this limitation.
+
@node Multilingual fonts
@section Multilingual font support
@cindex multilingual display, fonts
For many languages, native truetype fonts are sufficient, and in Emacs
23 the need for BDF fonts will disappear for almost all languages. At
-the time of writing, some Arabic characters in the HELLO file still do
-not display with native fonts, because they are pre-composed characters
-from MULE character sets rather than standard Unicode Arabic, but all
-other characters are able to be displayed with appropriate truetype or
-opentype fonts.
+the time of writing, all supported characters are able to be displayed
+with appropriate truetype or opentype fonts.
@node Non-latin display
@subsection How do I get Emacs to display non-latin characters?
chinese-big5-2:-*-MingLiU-normal-r-*-*-12-*-*-*-c-*-big5-*" t)
@end example
+Alternatively, you can augment the default fontset with information of
+which fonts to use for certain ranges of characters or for specific
+scripts/character sets. @xref{Modifying Fontsets,, Modifying
+Fontsets, emacs, The GNU Emacs Manual}, for details and some useful
+examples.
+
@node International fonts
@subsection Where can I find fonts for other languages?
@cindex language support, finding fonts
In addition to the wide range of fonts that come with the language
support packages of various components of Windows itself, GNU/Linux
distributions these days come with a number of Free truetype fonts
-that cover a wide range of languages. The GNU intlfonts source
-distribution contains BDF fonts covering all of the languages that can
-be displayed by Emacs 22, and can be downloaded from
-@uref{http://ftpmirror.gnu.org/intlfonts, ftp.gnu.org mirrors}.
+that cover a wide range of languages. The GNU Unifont project
+contains glyphs for most of the Unicode codespace, and can be
+downloaded from @uref{http://ftpmirror.gnu.org/unifont, ftp.gnu.org
+mirrors}.
@node Third-party multibyte
@subsection How do I use third party programs to display multibyte characters?
and using a different font behind the scenes).
@xref{Non-latin display}.
-In addition to defining a fontset with the expected font, you may also need
-to disable unicode output with:
-@example
-(setq w32-enable-unicode-output nil)
-@end example
-
@node Localized fonts
@subsection Can I use a font with a name in my language?
@cindex fonts, localized font names
based on your locale, which will let Emacs use font names in your local
language successfully.
-@node BDF fonts
-@section How do I use bdf fonts with Emacs?
-@cindex BDF fonts, using
-@cindex GNU intlfonts, using
-@cindex intlfonts, using
-@vindex w32-bdf-filename-alist
-@vindex bdf-directory-alist
-@vindex font-encoding-alist
-@findex w32-find-bdf-fonts
-@findex set-frame-font
-
-To use bdf fonts with Emacs, you need to tell Emacs where the fonts
-are located, create fontsets for them, and then use them. We'll use
-the 16 dot international fonts from @uref{http://ftpmirror.gnu.org/intlfonts,
-ftp.gnu.org/gnu/intlfonts} as an
-example put together by Jason Rumney.
-
-Download @file{16dots.tar.gz} and unpack it; I'll assume that they are in
-@file{c:\intlfonts}. Then set @code{w32-bdf-filename-alist} to the list of
-fonts returned by using @code{w32-find-bdf-fonts} to enumerate all of
-the font files. It is a good idea to set the variable
-@code{bdf-directory-list} at the same time so @code{ps-print} knows where
-to find the fonts:
-@example
-(setq bdf-directory-list
- '("c:/intlfonts/Asian" "c:/intlfonts/Chinese"
- "c:/intlfonts/Chinese-X" "c:/intlfonts/Ethiopic"
- "c:/intlfonts/European" "c:/intlfonts/Japanese"
- "c:/intlfonts/Japanese-X" "c:/intlfonts/Korean-X"
- "c:/intlfonts/Misc/"))
-
-(setq w32-bdf-filename-alist (w32-find-bdf-fonts bdf-directory-list))
-@end example
-
-Then create fontsets for the BDF fonts:
-
-@example
-(create-fontset-from-fontset-spec
- "-*-fixed-medium-r-normal-*-16-*-*-*-c-*-fontset-bdf,
-japanese-jisx0208:-*-*-medium-r-normal-*-16-*-*-*-c-*-jisx0208.1983-*,
-katakana-jisx0201:-*-*-medium-r-normal-*-16-*-*-*-c-*-jisx0201*-*,
-latin-jisx0201:-*-*-medium-r-normal-*-16-*-*-*-c-*-jisx0201*-*,
-japanese-jisx0208-1978:-*-*-medium-r-normal-*-16-*-*-*-c-*-jisx0208.1978-*,
-thai-tis620:-misc-fixed-medium-r-normal--16-160-72-72-m-80-tis620.2529-1,
-lao:-misc-fixed-medium-r-normal--16-160-72-72-m-80-MuleLao-1,
-tibetan-1-column:-TibMdXA-fixed-medium-r-normal--16-160-72-72-m-80-MuleTibetan-1,
-ethiopic:-Admas-Ethiomx16f-Medium-R-Normal--16-150-100-100-M-160-Ethiopic-Unicode,
-tibetan:-TibMdXA-fixed-medium-r-normal--16-160-72-72-m-160-MuleTibetan-0")
-@end example
-
-Many of the international bdf fonts from gnu.org are type 0, and therefore
-need to be added to font-encoding-alist:
-
-@example
-;; Need to add some fonts to font-encoding-alist since the bdf fonts
-;; are type 0 not the default type 1.
-(setq font-encoding-alist
- (append '(("MuleTibetan-0" (tibetan . 0))
- ("GB2312" (chinese-gb2312 . 0))
- ("JISX0208" (japanese-jisx0208 . 0))
- ("JISX0212" (japanese-jisx0212 . 0))
- ("VISCII" (vietnamese-viscii-lower . 0))
- ("KSC5601" (korean-ksc5601 . 0))
- ("MuleArabic-0" (arabic-digit . 0))
- ("MuleArabic-1" (arabic-1-column . 0))
- ("MuleArabic-2" (arabic-2-column . 0))) font-encoding-alist))
-@end example
-
-You can now use the Emacs font menu (@pxref{Fonts and text
-translation,,How can I have Emacs use a font menu like on X?}) to
-select the @emph{bdf: 16-dot medium} fontset, or you can select it by
-setting the default font:
-
-@example
- (set-frame-font "fontset-bdf")
-@end example
-
-Try loading the file @file{etc/HELLO}, and you should be able to see the
-various international fonts displayed (except for Hindi, which is not
-included in the 16-dot font distribution).
-
+@c This feature disappeared in Emacs 23, and was resurrected in 25.1.
@node Font menu
@section How can I have Emacs use a font menu like on X?
@cindex fonts, displaying a menu
* Add fonts to menu::
@end menu
+@c This variable had no effect between v23 and v25.1, where
+@c w32-use-w32-font-dialog support was resurrected, see above.
@node Add fonts to menu
@subsection How can I add my font to the font menu?
@cindex font menu, adding fonts
@menu
* Automatic line ends::
-* Line ends by filename::
* Line ends by file system::
@end menu
It does this to be safe, as no data loss will occur if the file is really
binary and the Ctrl-M characters are significant.
-@node Line ends by filename
-@subsection CR/LF translation by file extension
-@cindex line ends, determining by filename
-@cindex binary files, determining by file name
-@vindex file-name-buffer-file-type-alist
-
-The variable @code{file-name-buffer-file-type-alist} holds a list of
-filename patterns and their associated type; binary or text. Files marked
-as binary will not have line-end detection performed on them, and instead
-will always be displayed as is. With auto-detection in recent versions of
-Emacs, this is seldom useful for existing files, but can still be used
-to influence the choice of line ends for newly created files.
-
@node Line ends by file system
@subsection CR/LF translation by file system
@cindex line ends, determining by filesystem
changes in printing technology from text and postscript based printers
connected via ports that can be accessed directly, to graphical
printers that are only accessible via USB. For details, see
-@uref{http://www.emacswiki.org/cgi-bin/wiki/PrintingFromEmacs, Emacs
-Wiki}.
+@uref{http://www.emacswiki.org/emacs/PrintingFromEmacs, Emacs
+Wiki}, @uref{http://www.emacswiki.org/emacs/PrintWithWebBrowser}, and
+@uref{http://www.emacswiki.org/emacs/PrintFromWindowsExplorer}.
@c ------------------------------------------------------------
@node Sub-processes
The quoting rules for native Windows shells and Cygwin shells have
some subtle differences. When Emacs spawns subprocesses, it tries to
determine whether the process is a Cygwin program and changes its
-quoting mechanism appropriately. See this
-@uref{http://www.gnu.org/software/emacs/windows/ntemacs/discuss/shell-quoting,
-previous discussion} for details.
+quoting mechanism appropriately.
@node Subprocess hang
@section Programs reading input hang
the buffering semantics.
Some programs handle this by having an explicit flag to control their
-buffering behavior, typically @option{-i} for interactive. Other
-programs manage to detect that they are running under Emacs, by
-using @samp{getenv("emacs")} internally.
+buffering behavior, typically @option{-i} for interactive, or by a
+special environment variable. Other programs manage to detect that
+they are running under Emacs, by using @samp{getenv("emacs")}
+internally. Look in the program's documentation for the way around
+this issue.
@menu
* Perl script buffering::
@vindex explicit-shell-file-name
You can start an interactive shell in Emacs by typing @kbd{M-x shell}.
+By default, this will start the standard Windows shell @file{cmd.exe}.
Emacs uses the @env{SHELL} environment variable to determine which
program to use as the shell. To instruct Emacs to use a non-default
shell, you can either set this environment variable, or customize
(add-hook 'shell-mode-hook 'my-shell-setup)
@end example
-If you find that you are having trouble with Emacs tracking drive
-changes with bash, see Mike Fabian's
-@uref{http://www.gnu.org/software/emacs/windows/ntemacs/discuss/drive-tracking,
-note}.
-
WARNING: Some versions of bash set and use the environment variable
PID. For some as yet unknown reason, if @env{PID} is set and Emacs
passes it on to bash subshells, bash dies (Emacs can inherit the
@cindex cygwin mount points, using within Emacs
The package
-@uref{http://www.emacswiki.org/cgi-bin/wiki/cygwin-mount.el,
+@uref{http://www.emacswiki.org/emacs/cygwin-mount.el,
cygwin-mount.el} teaches Emacs about Cygwin mount points.
@node Dired ls
@command{ispell} 3.2 or a compatible spell-checking program.
GNU Aspell is a popular choice these days, Windows installers are
available from the @uref{http://aspell.net/win32/, official site}.
+Another possibility is Hunspell, which is available from
+@uref{https://sourceforge.net/projects/ezwinports/files/?source=navbar,
+the ezwinports site}.
Once installed, you will need to configure @code{ispell-program-name}
-to tell ispell and flyspell to use @command{aspell} as a replacement for
-ispell. You can include the full path to the @file{aspell} binary, which
-means you do not need to add its installation directory to the @env{PATH}.
+to tell ispell and flyspell to use @command{aspell} or
+@command{hunspell} as a replacement for ispell. You can include the
+full path to the @file{aspell}/@file{hunspell} binary, which means you
+do not need to add its installation directory to the @env{PATH}.
@node Encryption
@section Emacs and encryption
@node Developing with Emacs
@chapter Developing with Emacs
+We recommend using the GNU Compiler Collection for developing C/C++
+code from Emacs. The MinGW development toolchain provides Windows
+ports of GCC and other compilers.
+
+The rest of this chapter describes other alternatives which you may
+need to use.
+
@menu
* MSVC::
* Borland C++ Builder::
Christopher Payne wrote a Visual Studio add-in that makes Emacs the
default text editor, this has now been taken over by Jeff Paquette.
-See the following two URLS for details:
+See the following two URLs for details:
@itemize
@item @uref{http://sourceforge.net/projects/visemacs/} for the latest version.
@item @uref{http://www.smathers.net/VisEmacs.htm} for notes on usage.
@menu
* Cygwin::
* MinGW::
+* EZWinPorts::
* UWIN::
* GnuWin32::
* GTK::
runs. This is intended to complement the MinGW tools to make it easier
to port software to Windows.
+@node EZWinPorts
+@section EZWinPorts
+@cindex ezwinports
+
+The @uref{https://sourceforge.net/projects/ezwinports/, EZWinPorts
+project} provides many useful ports of recent versions of GNU and Unix
+software. This includes all the optional libraries used by Emacs
+(image libraries, libxml2, GnuTLS), RCS, Texinfo, a clone of
+@command{man} command, Grep, xz, bzip2, bsdtar, ID Utils, Findutils,
+Hunspell, Gawk, GNU Make, Groff, GDB.
+
@node UWIN
@section UWIN
@cindex uwin environment
@uref{http://gnuwin32.sourceforge.net/}
GnuWin32 provides precompiled native Windows ports of a wide selection
-of Free software and libraries. Tools available here that are useful
-for Emacs include:
+of Free software and libraries. Unfortunately, the ports are
+outdated. Tools available here that are useful for Emacs include:
@itemize
@item Arc - used by @code{archive-mode} to edit .arc files.
read using Emacs' built-in manual reader @code{woman}. This
requires no external programs, but if you do have a port of
@command{man}, there is also an Emacs wrapper @code{man} that
-which may be slightly faster.
+which may be slightly faster. A Windows version of @command{man} is
+available from the EZWinPorts site (@pxref{EZWinPorts}).
@c ------------------------------------------------------------
@node Further information
@cindex Maximize frame
@cindex Fullscreen mode
-Use the function @code{w32-send-sys-command}. For example, you can
-put the following in your @file{.emacs} file:
+Beginning with Emacs 24.4 either run Emacs with the @samp{--maximized}
+command-line option or put the following form in your @file{.emacs}
+file:
+
+@lisp
+(add-hook 'emacs-startup-hook 'toggle-frame-maximized)
+@end lisp
+
+With older versions use the function @code{w32-send-sys-command}. For
+example, you can put the following in your @file{.emacs} file:
@lisp
(add-hook 'emacs-startup-hook
First off, please note that this manual cannot serve as a complete
introduction to object oriented programming and generic functions in
-LISP. Although EIEIO is not a complete implementation of the Common
+LISP@. Although EIEIO is not a complete implementation of the Common
Lisp Object System (CLOS) and also differs from it in several aspects,
it follows the same basic concepts. Therefore, it is highly
recommended to learn those from a textbook or tutorial first,
@lisp
;;; Sample ERC configuration
-;; Add the ERC directory to load path -- you don't need this if you are
-;; using the version of ERC that comes with Emacs
-(add-to-list 'load-path "~/elisp/erc")
-
-;; Load ERC -- again, you don't need this if you are using the version
-;; of ERC that comes with Emacs
-(require 'erc)
-
;; Load authentication info from an external source. Put sensitive
;; passwords and the like in here.
(load "~/.emacs.d/.erc-auth")
(setq erc-autojoin-channels-alist '(("freenode.net" "#emacs" "#erc")))
;; Rename server buffers to reflect the current network name instead
-;; of IP:PORT. (e.g. "freenode" instead of "84.240.3.129:6667"). This
-;; is useful when using a bouncer like ZNC where you have multiple
+;; of SERVER:PORT (e.g., "freenode" instead of "irc.freenode.net:6667").
+;; This is useful when using a bouncer like ZNC where you have multiple
;; connections to the same server.
(setq erc-rename-buffers t)
@item
@uref{http://www.emacswiki.org/cgi-bin/wiki/ERC} is the
-emacswiki.org page for ERC@. Anyone may add tips, hints, etc. to it.
+emacswiki.org page for ERC@. Anyone may add tips, hints, etc.@: to it.
@item
You can ask questions about using ERC on the Emacs mailing list,
to in this manual as ``visual commands,'' because they are not simply
line-oriented. You must tell Eshell which commands are visual, by
adding them to @code{eshell-visual-commands}; for commands that are
-visual for only certain @emph{sub}-commands -- e.g. @samp{git log} but
+visual for only certain @emph{sub}-commands -- e.g., @samp{git log} but
not @samp{git status} -- use @code{eshell-visual-subcommands}; and for
commands that are visual only when passed certain options, use
@code{eshell-visual-options}.
which part of the document contains the ``readable'' text, and will
only display this part. This usually gets rid of menus and the like.
+@findex eww-toggle-fonts
+@findex shr-use-fonts
+@kindex F
+ The @kbd{F} command (@code{eww-toggle-fonts}) toggles whether to use
+variable-pitch fonts or not. This sets the @code{shr-use-fonts} variable.
+
@findex eww-download
@vindex eww-download-directory
@kindex d
@cindex History
EWW remembers the URLs you have visited to allow you to go back and
forth between them. By pressing @kbd{l} (@code{eww-back-url}) you go
-to the previous URL. You can go forward again with @kbd{r}
+to the previous URL@. You can go forward again with @kbd{r}
(@code{eww-forward-url}). If you want an overview of your browsing
history press @kbd{H} (@code{eww-list-histories}) to open the history
buffer @file{*eww history*}. The history is lost when EWW is quit.
@vindex eww-desktop-remove-duplicates
EWW history may sensibly contain multiple entries for the same page
-URI. At run-time, these entries may still have different associated
+URI@. At run-time, these entries may still have different associated
point positions or the actual Web page contents.
The latter, however, tend to be overly large to preserve in the
desktop file, so they get omitted, thus rendering the respective
article. That's well and nice, but there's also lots of information
most people do not want to see---what systems the article has passed
through before reaching you, the @code{Message-ID}, the
-@code{References}, etc. ad nauseam---and you'll probably want to get rid
+@code{References}, etc.@: ad nauseam---and you'll probably want to get rid
of some of those lines. If you want to keep all those lines in the
article buffer, you can set @code{gnus-show-all-headers} to @code{t}.
* Connecting to an IMAP Server:: Getting started with @acronym{IMAP}.
* Customizing the IMAP Connection:: Variables for @acronym{IMAP} connection.
* Client-Side IMAP Splitting:: Put mail in the correct mail box.
+* Support for IMAP Extensions:: Getting extensions and labels from servers.
@end menu
@end example
+@node Support for IMAP Extensions
+@subsection Support for IMAP Extensions
+
+@cindex Gmail
+@cindex X-GM-LABELS
+@cindex IMAP labels
+
+If you're using Google's Gmail, you may want to see your Gmail labels
+when reading your mail. Gnus can give you this information if you ask
+for @samp{X-GM-LABELS} in the variable @code{gnus-extra-headers}. For
+example:
+
+@example
+(setq gnus-extra-headers
+ '(To Newsgroups X-GM-LABELS))
+@end example
+
+This will result in Gnus storing your labels in message header
+structures for later use. The content is always a parenthesized
+(possible empty) list.
+
+
+
@node Getting Mail
@section Getting Mail
@cindex reading mail
The registry can store custom flags and keywords for a message. For
instance, you can mark a message ``To-Do'' this way and the flag will
persist whether the message is in the nnimap, nnml, nnmaildir,
-etc. backends.
+etc.@: backends.
@item
Store arbitrary data
@code{gnus-registry-max-entries}. This option controls exactly how
much less: the target is calculated as the maximum number of entries
minus the maximum number times this factor. The default is 0.1:
-i.e. if your registry is limited to 50000 entries, pruning will try to
+i.e., if your registry is limited to 50000 entries, pruning will try to
cut back to 45000 entries. Entries with keys marked as precious will
not be pruned.
@end defvar
(hfy-face-at P)
@end lisp
-Find face in effect at point P. If overlays are to be considered
+Find face in effect at point P@. If overlays are to be considered
(see @ref{hfy-optimisations}) then this may return a @code{defface} style
list of face properties instead of a face symbol.
a page with different colors than the fontified code.)
@item keep-overlays
-Preserve overlay highlighting (c.f. @code{ediff} or @code{goo-font-lock})
+Preserve overlay highlighting (cf.@: @code{ediff} or @code{goo-font-lock})
as well as basic faces. Can result in extremely verbose highlighting
if there are many overlays (as is the case with @code{goo-font-lock}).
@cindex Highlighting of syntax
@cindex Font lock
-Highlighting of keywords, comments, strings etc. can be accomplished
+Highlighting of keywords, comments, strings etc.@: can be accomplished
with @code{font-lock}. If you are using @code{global-font-lock-mode}
(in Emacs), or have @code{font-lock} turned on in any other buffer in
XEmacs, it should also automatically work in IDLWAVE buffers. If you'd
@kindex C-c C-d C-p
Do you find yourself repeatedly typing, e.g., @code{print,n_elements(x)},
and similar statements to remind yourself of the
-type/size/structure/value/etc. of variables and expressions in your code
+type/size/structure/value/etc.@: of variables and expressions in your code
or at the command line? IDLWAVE has a suite of special commands to
automate these types of variable or expression examinations. They work
by sending statements to the shell formatted to include the indicated
whether this help browser is used. If you use the IDL Assistant, the
tips here are not relevant.
-Since IDLWAVE runs on a many different system types, a single browser
-configuration is not possible, but choices abound. On many systems,
-the default browser configured in @code{browse-url-browser-function},
-and hence inherited by default by
-@code{idlwave-help-browser-function}, is Netscape. Unfortunately, the
-HTML manuals decompiled from the original source contain formatting
-structures which Netscape 4.x does not handle well, though they are
-still readable. A much better choice is Mozilla, or one of the
-Mozilla-derived browsers such as
-@uref{http://galeon.sourceforge.net/,Galeon} (GNU/Linux),
-@uref{http://www.mozilla.org/projects/camino/,Camino} (MacOSX), or
-@uref{http://www.mozilla.org/projects/firebird/,Firebird} (all
-platforms). Newer versions of Emacs provide a browser-function choice
-@code{browse-url-gnome-moz} which uses the Gnome-configured browser.
+Since IDLWAVE runs on many different system types, a single browser
+configuration is not possible, but choices abound. The default
+@code{idlwave-help-browser-function} inherits the browser configured
+in @code{browse-url-browser-function}.
Note that the HTML files decompiled from the help sources contain
specific references to the @samp{Symbol} font, which by default is not
permitted in normal encodings (it's invalid, technically). Though it
only impacts a few symbols, you can trick Mozilla-based browsers into
recognizing @samp{Symbol} by following the directions
+@c This page is 11 years old. Is it still relevant?
@uref{http://hutchinson.belmont.ma.us/tth/Xfonts.html, here}. With
this fix in place, HTML help pages look almost identical to their PDF
equivalents (yet can be bookmarked, browsed as history, searched,
etc.).
+@c Not updated in over a decade.
+@c Maybe you want to recommend eww these days.
+@ignore
@noindent Individual platform recommendations:
@itemize @bullet
Note that you can open the file in an external browser from within
@code{w3m} using @kbd{M}.
@end itemize
+@end ignore
@node Configuration Examples
@appendix Configuration Examples
of the list and hit @key{RET}.
To go up to the parent directory, delete any partial file name already
-specified (e.g. using @key{DEL}) and hit @key{DEL}.
+specified (e.g., using @key{DEL}) and hit @key{DEL}.
@c @deffn Command ido-delete-backward-updir
@vindex newsticker-url-list
@item newsticker-url-list
All your personal news feeds are defined here. Each feed is
-identified by its name and an URL. You may set the start-time and the
+identified by its name and an URL@. You may set the start-time and the
retrieval interval for each feed as well as the retrieval command
arguments in case that the default values do not fit a certain feed.
@subheading RSS formats
@itemize
-@item RSS 0.91 (see @uref{http://backend.userland.com/rss091} or
-@uref{http://my.netscape.com/publish/formats/rss-spec-0.91.html})
+@item RSS 0.91 (see @uref{http://backend.userland.com/rss091})
@item RSS 0.92 (see @uref{http://backend.userland.com/rss092})
@item RSS 1.0 (see @uref{http://purl.org/rss/1.0/spec})
@item RSS 2.0 (see @uref{http://blogs.law.harvard.edu/tech/rss})
Elisp libraries. You can install Org with @kbd{M-x package-install RET org}.
@noindent @b{Important}: you need to do this in a session where no @code{.org} file has
-been visited, i.e. where no Org built-in function have been loaded.
+been visited, i.e., where no Org built-in function have been loaded.
Otherwise autoload Org functions will mess up the installation.
Then, to make sure your Org configuration is taken into account, initialize
@item C-v
Toggle visible-only export. Only export the text that is currently
-visible, i.e. not hidden by outline visibility in the buffer.
+visible, i.e., not hidden by outline visibility in the buffer.
@end table
A link with no description and destined to a regular (un-itemized) outline
heading is replaced with a cross-reference and section number of the heading.
-A @samp{\ref@{label@}}-style reference to an image, table etc. is replaced
+A @samp{\ref@{label@}}-style reference to an image, table etc.@: is replaced
with a cross-reference and sequence number of the labeled entity.
@xref{Labels and captions in ODT export}.
This is obviously the most powerful customization, since the changes happen
at the parser level. Indeed, some export back-ends are built as extensions
-of other ones (e.g. Markdown back-end an extension of HTML back-end).
+of other ones (e.g., Markdown back-end an extension of HTML back-end).
Extending a back-end means that if an element type is not transcoded by the
new back-end, it will be handled by the original one. Hence you can extend
deal with detached PGP messages, normally used in PGP/MIME
infrastructure. This was the main reason why I wrote the new library.
-Note that the PGG library is now obsolete, replaced by EasyPG.
+Note that the PGG library is now obsolete, replaced by EasyPG@.
@xref{Top,, EasyPG, epa, EasyPG Assistant User's Manual}.
PGP/MIME is an application of MIME Object Security Services (RFC1848).
@item <
Promote the current section. This will convert @code{\section} to
-@code{\chapter}, @code{\subsection} to @code{\section} etc. If there is
+@code{\chapter}, @code{\subsection} to @code{\section} etc. If there is
an active region, all sections in the region will be promoted, including
the one at point. To avoid mistakes, @RefTeX{} requires a fresh
document scan before executing this command; if necessary, it will
@cindex @code{linguex}, LaTeX package
@cindex LaTeX packages, @code{linguex}
A more complex example is the @file{linguex.sty} package which defines
-list macros @samp{\ex.}, @samp{\a.}, @samp{\b.} etc. for lists which are
+list macros @samp{\ex.}, @samp{\a.}, @samp{\b.} etc.@: for lists which are
terminated by @samp{\z.} or by an empty line.
@example
exception is that section labels referring to a section statement
outside the current file can still use that section title as
context.
+
+@item
+@vindex reftex-include-file-commands
+@RefTeX{} knows about the @code{\include} and @code{\input} macros.
+In case you use different commands to include files in a multifile
+document, customize the variable @code{reftex-include-file-commands}.
@end itemize
@node Language Support
@code{customize} to look at and change these variables. @kbd{M-x
reftex-customize} will get you there.
+In case you don't use the @code{customize} interface, here's a caveat:
+Changing (mostly parsing-related) options might require a call to
+@code{reftex-compile-variables} in order to become effective.
+
@menu
* Options - Table of Contents::
* Options - Defining Label Environments::
@noindent @b{Version 3.11}
@itemize @bullet
@item
-Fixed bug which led to naked label in (e.g.@:) footnotes.
+Fixed bug which led to naked label in (e.g.)@: footnotes.
@item
Added scroll-other-window functions to RefTeX-Select.
@end itemize
@defun remember-clipboard
Remember the contents of the current clipboard. This is most useful
-for remembering things from Netscape or other X Windows applications.
+for remembering things from a web browser or other X Windows applications.
@end defun
@defun remember-finalize
% Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
%
-\def\texinfoversion{2014-12-03.16}
+\def\texinfoversion{2015-02-05.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, 2012, 2013, 2014 Free Software Foundation, Inc.
+% 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015
+% 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
% Called from \indexdummies and \atdummies.
%
\def\commondummies{%
- %
% \definedummyword defines \#1 as \string\#1\space, thus effectively
% preventing its expansion. This is used only for control words,
% not control letters, because the \space would be incorrect for
\definedummyword\guilsinglright
\definedummyword\lbracechar
\definedummyword\leq
+ \definedummyword\mathopsup
\definedummyword\minus
\definedummyword\ogonek
\definedummyword\pounds
\definedummyword\quotesinglbase
\definedummyword\rbracechar
\definedummyword\result
+ \definedummyword\sub
+ \definedummyword\sup
\definedummyword\textdegree
%
% We want to disable all macros so that they are not expanded by \write.
\definedummyword\samp
\definedummyword\strong
\definedummyword\tie
+ \definedummyword\U
\definedummyword\uref
\definedummyword\url
\definedummyword\var
\catcode`\\=\other
%
% Make the characters 128-255 be printing characters.
- {%
- \count1=128
- \def\loop{%
- \catcode\count1=\other
- \advance\count1 by 1
- \ifnum \count1<256 \loop \fi
- }%
- }%
+ {\setnonasciicharscatcodenonglobal\other}%
%
% @ is our escape character in .aux files, and we need braces.
\catcode`\{=1
\catcode\count255=#1\relax
\advance\count255 by 1
\repeat
+
}
% @documentencoding sets the definition of non-ASCII characters
%
\else \ifx \declaredencoding \utfeight
\setnonasciicharscatcode\active
- \utfeightchardefs
+ % since we already invoked \utfeightchardefs at the top level
+ % (below), do not re-invoke it, then our check for duplicated
+ % definitions triggers. Making non-ascii chars active is enough.
%
\else
- \message{Unknown document encoding #1, ignoring.}%
+ \message{Ignoring unknown document encoding: #1.}%
%
\fi % utfeight
\fi % latnine
\fi % ascii
}
+% emacs-page
% A message to be logged when using a character that isn't available
% the default font encoding (OT1).
%
-\def\missingcharmsg#1{\message{Character missing in OT1 encoding: #1.}}
+\def\missingcharmsg#1{\message{Character missing, sorry: #1.}}
% Take account of \c (plain) vs. \, (Texinfo) difference.
\def\cedilla#1{\ifx\c\ptexc\c{#1}\else\,{#1}\fi}
\gdef^^b4{\'{}}
\gdef^^b5{$\mu$}
\gdef^^b6{\P}
- %
- \gdef^^b7{$^.$}
+ \gdef^^b7{\ifmmode\cdot\else $\cdot$\fi}
\gdef^^b8{\cedilla\ }
\gdef^^b9{$^1$}
\gdef^^ba{\ordm}
- %
\gdef^^bb{\guillemetright}
\gdef^^bc{$1\over4$}
\gdef^^bd{$1\over2$}
\expandafter\expandafter\expandafter\expandafter
\expandafter\expandafter\expandafter
\gdef\UTFviiiTmp{#2}%
+ %
+ \expandafter\ifx\csname uni:#1\endcsname \relax \else
+ \errmessage{Internal error, already defined: #1}%
+ \fi
+ %
% define an additional control sequence for this code point.
\expandafter\globallet\csname uni:#1\endcsname \UTFviiiTmp
\endgroup}
\uppercase{\gdef\UTFviiiTmp{#2#3#4}}}
\endgroup
+% https://en.wikipedia.org/wiki/Plane_(Unicode)#Basic_M
+% U+0000..U+007F = https://en.wikipedia.org/wiki/Basic_Latin_(Unicode_block)
+% U+0080..U+00FF = https://en.wikipedia.org/wiki/Latin-1_Supplement_(Unicode_block)
+% U+0100..U+017F = https://en.wikipedia.org/wiki/Latin_Extended-A
+% U+0180..U+024F = https://en.wikipedia.org/wiki/Latin_Extended-B
+%
+% Many of our renditions are less than wonderful, and all the missing
+% characters are available somewhere. Loading the necessary fonts
+% awaits user request. We can't truly support Unicode without
+% reimplementing everything that's been done in LaTeX for many years,
+% plus probably using luatex or xetex, and who knows what else.
+% We won't be doing that here in this simple file. But we can try to at
+% least make most of the characters not bomb out.
+%
\def\utfeightchardefs{%
\DeclareUnicodeCharacter{00A0}{\tie}
\DeclareUnicodeCharacter{00A1}{\exclamdown}
\DeclareUnicodeCharacter{00A3}{\pounds}
+ \DeclareUnicodeCharacter{00A7}{\S}
\DeclareUnicodeCharacter{00A8}{\"{ }}
\DeclareUnicodeCharacter{00A9}{\copyright}
\DeclareUnicodeCharacter{00AA}{\ordf}
\DeclareUnicodeCharacter{00AB}{\guillemetleft}
+ \DeclareUnicodeCharacter{00AC}{\ifmmode\lnot\else $\lnot$\fi}
\DeclareUnicodeCharacter{00AD}{\-}
\DeclareUnicodeCharacter{00AE}{\registeredsymbol}
\DeclareUnicodeCharacter{00AF}{\={ }}
\DeclareUnicodeCharacter{00B0}{\ringaccent{ }}
+ \DeclareUnicodeCharacter{00B1}{\ifmmode\pm\else $\pm$\fi}
+ \DeclareUnicodeCharacter{00B2}{$^2$}
+ \DeclareUnicodeCharacter{00B3}{$^3$}
\DeclareUnicodeCharacter{00B4}{\'{ }}
+ \DeclareUnicodeCharacter{00B5}{$\mu$}
+ \DeclareUnicodeCharacter{00B6}{\P}
+ \DeclareUnicodeCharacter{00B7}{\ifmmode\cdot\else $\cdot$\fi}
\DeclareUnicodeCharacter{00B8}{\cedilla{ }}
+ \DeclareUnicodeCharacter{00B9}{$^1$}
\DeclareUnicodeCharacter{00BA}{\ordm}
\DeclareUnicodeCharacter{00BB}{\guillemetright}
+ \DeclareUnicodeCharacter{00BC}{$1\over4$}
+ \DeclareUnicodeCharacter{00BD}{$1\over2$}
+ \DeclareUnicodeCharacter{00BE}{$3\over4$}
\DeclareUnicodeCharacter{00BF}{\questiondown}
\DeclareUnicodeCharacter{00C0}{\`A}
\DeclareUnicodeCharacter{00D4}{\^O}
\DeclareUnicodeCharacter{00D5}{\~O}
\DeclareUnicodeCharacter{00D6}{\"O}
+ \DeclareUnicodeCharacter{00D7}{\ifmmode\times\else $\times$\fi}
\DeclareUnicodeCharacter{00D8}{\O}
\DeclareUnicodeCharacter{00D9}{\`U}
\DeclareUnicodeCharacter{00DA}{\'U}
\DeclareUnicodeCharacter{00F4}{\^o}
\DeclareUnicodeCharacter{00F5}{\~o}
\DeclareUnicodeCharacter{00F6}{\"o}
+ \DeclareUnicodeCharacter{00F7}{\ifmmode\div\else $\div$\fi}
\DeclareUnicodeCharacter{00F8}{\o}
\DeclareUnicodeCharacter{00F9}{\`u}
\DeclareUnicodeCharacter{00FA}{\'u}
\DeclareUnicodeCharacter{0107}{\'c}
\DeclareUnicodeCharacter{0108}{\^C}
\DeclareUnicodeCharacter{0109}{\^c}
- \DeclareUnicodeCharacter{0118}{\ogonek{E}}
- \DeclareUnicodeCharacter{0119}{\ogonek{e}}
\DeclareUnicodeCharacter{010A}{\dotaccent{C}}
\DeclareUnicodeCharacter{010B}{\dotaccent{c}}
\DeclareUnicodeCharacter{010C}{\v{C}}
\DeclareUnicodeCharacter{010D}{\v{c}}
\DeclareUnicodeCharacter{010E}{\v{D}}
+ \DeclareUnicodeCharacter{010F}{d'}
+ \DeclareUnicodeCharacter{0110}{\DH}
+ \DeclareUnicodeCharacter{0111}{\dh}
\DeclareUnicodeCharacter{0112}{\=E}
\DeclareUnicodeCharacter{0113}{\=e}
\DeclareUnicodeCharacter{0114}{\u{E}}
\DeclareUnicodeCharacter{0115}{\u{e}}
\DeclareUnicodeCharacter{0116}{\dotaccent{E}}
\DeclareUnicodeCharacter{0117}{\dotaccent{e}}
+ \DeclareUnicodeCharacter{0118}{\ogonek{E}}
+ \DeclareUnicodeCharacter{0119}{\ogonek{e}}
\DeclareUnicodeCharacter{011A}{\v{E}}
\DeclareUnicodeCharacter{011B}{\v{e}}
\DeclareUnicodeCharacter{011C}{\^G}
\DeclareUnicodeCharacter{0120}{\dotaccent{G}}
\DeclareUnicodeCharacter{0121}{\dotaccent{g}}
+ \DeclareUnicodeCharacter{0122}{\cedilla{G}}
+ \DeclareUnicodeCharacter{0123}{\cedilla{g}}
\DeclareUnicodeCharacter{0124}{\^H}
\DeclareUnicodeCharacter{0125}{\^h}
+ \DeclareUnicodeCharacter{0126}{\missingcharmsg{H WITH STROKE}}
+ \DeclareUnicodeCharacter{0127}{\missingcharmsg{h WITH STROKE}}
\DeclareUnicodeCharacter{0128}{\~I}
\DeclareUnicodeCharacter{0129}{\~{\dotless{i}}}
\DeclareUnicodeCharacter{012A}{\=I}
\DeclareUnicodeCharacter{012B}{\={\dotless{i}}}
\DeclareUnicodeCharacter{012C}{\u{I}}
\DeclareUnicodeCharacter{012D}{\u{\dotless{i}}}
+ \DeclareUnicodeCharacter{012E}{\ogonek{I}}
+ \DeclareUnicodeCharacter{012F}{\ogonek{i}}
\DeclareUnicodeCharacter{0130}{\dotaccent{I}}
\DeclareUnicodeCharacter{0131}{\dotless{i}}
\DeclareUnicodeCharacter{0133}{ij}
\DeclareUnicodeCharacter{0134}{\^J}
\DeclareUnicodeCharacter{0135}{\^{\dotless{j}}}
+ \DeclareUnicodeCharacter{0136}{\cedilla{K}}
+ \DeclareUnicodeCharacter{0137}{\cedilla{k}}
+ \DeclareUnicodeCharacter{0138}{\ifmmode\kappa\else $\kappa$\fi}
\DeclareUnicodeCharacter{0139}{\'L}
\DeclareUnicodeCharacter{013A}{\'l}
+ \DeclareUnicodeCharacter{013B}{\cedilla{L}}
+ \DeclareUnicodeCharacter{013C}{\cedilla{l}}
+ \DeclareUnicodeCharacter{013D}{L'}% should kern
+ \DeclareUnicodeCharacter{013E}{l'}% should kern
+ \DeclareUnicodeCharacter{013F}{L\U{00B7}}
+ \DeclareUnicodeCharacter{0140}{l\U{00B7}}
\DeclareUnicodeCharacter{0141}{\L}
\DeclareUnicodeCharacter{0142}{\l}
\DeclareUnicodeCharacter{0143}{\'N}
\DeclareUnicodeCharacter{0144}{\'n}
+ \DeclareUnicodeCharacter{0145}{\cedilla{N}}
+ \DeclareUnicodeCharacter{0146}{\cedilla{n}}
\DeclareUnicodeCharacter{0147}{\v{N}}
\DeclareUnicodeCharacter{0148}{\v{n}}
+ \DeclareUnicodeCharacter{0149}{'n}
+ \DeclareUnicodeCharacter{014A}{\missingcharmsg{ENG}}
+ \DeclareUnicodeCharacter{014B}{\missingcharmsg{eng}}
\DeclareUnicodeCharacter{014C}{\=O}
\DeclareUnicodeCharacter{014D}{\=o}
\DeclareUnicodeCharacter{014E}{\u{O}}
\DeclareUnicodeCharacter{0153}{\oe}
\DeclareUnicodeCharacter{0154}{\'R}
\DeclareUnicodeCharacter{0155}{\'r}
+ \DeclareUnicodeCharacter{0156}{\cedilla{R}}
+ \DeclareUnicodeCharacter{0157}{\cedilla{r}}
\DeclareUnicodeCharacter{0158}{\v{R}}
\DeclareUnicodeCharacter{0159}{\v{r}}
\DeclareUnicodeCharacter{015A}{\'S}
\DeclareUnicodeCharacter{0160}{\v{S}}
\DeclareUnicodeCharacter{0161}{\v{s}}
- \DeclareUnicodeCharacter{0162}{\cedilla{t}}
- \DeclareUnicodeCharacter{0163}{\cedilla{T}}
+ \DeclareUnicodeCharacter{0162}{\cedilla{T}}
+ \DeclareUnicodeCharacter{0163}{\cedilla{t}}
\DeclareUnicodeCharacter{0164}{\v{T}}
-
+ \DeclareUnicodeCharacter{0165}{\v{t}}
+ \DeclareUnicodeCharacter{0166}{\missingcharmsg{H WITH STROKE}}
+ \DeclareUnicodeCharacter{0167}{\missingcharmsg{h WITH STROKE}}
\DeclareUnicodeCharacter{0168}{\~U}
\DeclareUnicodeCharacter{0169}{\~u}
\DeclareUnicodeCharacter{016A}{\=U}
\DeclareUnicodeCharacter{0170}{\H{U}}
\DeclareUnicodeCharacter{0171}{\H{u}}
+ \DeclareUnicodeCharacter{0172}{\ogonek{U}}
+ \DeclareUnicodeCharacter{0173}{\ogonek{u}}
\DeclareUnicodeCharacter{0174}{\^W}
\DeclareUnicodeCharacter{0175}{\^w}
\DeclareUnicodeCharacter{0176}{\^Y}
\DeclareUnicodeCharacter{017C}{\dotaccent{z}}
\DeclareUnicodeCharacter{017D}{\v{Z}}
\DeclareUnicodeCharacter{017E}{\v{z}}
+ \DeclareUnicodeCharacter{017F}{\missingcharmsg{LONG S}}
\DeclareUnicodeCharacter{01C4}{D\v{Z}}
\DeclareUnicodeCharacter{01C5}{D\v{z}}
\DeclareUnicodeCharacter{2261}{\equiv}
}% end of \utfeightchardefs
-
% US-ASCII character definitions.
\def\asciichardefs{% nothing need be done
\relax
}
+% Latin1 (ISO-8859-1) character definitions.
+\def\nonasciistringdefs{%
+ \setnonasciicharscatcode\active
+ \def\defstringchar##1{\def##1{\string##1}}%
+ \defstringchar^^a0\defstringchar^^a1\defstringchar^^a2\defstringchar^^a3%
+ \defstringchar^^a4\defstringchar^^a5\defstringchar^^a6\defstringchar^^a7%
+ \defstringchar^^a8\defstringchar^^a9\defstringchar^^aa\defstringchar^^ab%
+ \defstringchar^^ac\defstringchar^^ad\defstringchar^^ae\defstringchar^^af%
+ %
+ \defstringchar^^b0\defstringchar^^b1\defstringchar^^b2\defstringchar^^b3%
+ \defstringchar^^b4\defstringchar^^b5\defstringchar^^b6\defstringchar^^b7%
+ \defstringchar^^b8\defstringchar^^b9\defstringchar^^ba\defstringchar^^bb%
+ \defstringchar^^bc\defstringchar^^bd\defstringchar^^be\defstringchar^^bf%
+ %
+ \defstringchar^^c0\defstringchar^^c1\defstringchar^^c2\defstringchar^^c3%
+ \defstringchar^^c4\defstringchar^^c5\defstringchar^^c6\defstringchar^^c7%
+ \defstringchar^^c8\defstringchar^^c9\defstringchar^^ca\defstringchar^^cb%
+ \defstringchar^^cc\defstringchar^^cd\defstringchar^^ce\defstringchar^^cf%
+ %
+ \defstringchar^^d0\defstringchar^^d1\defstringchar^^d2\defstringchar^^d3%
+ \defstringchar^^d4\defstringchar^^d5\defstringchar^^d6\defstringchar^^d7%
+ \defstringchar^^d8\defstringchar^^d9\defstringchar^^da\defstringchar^^db%
+ \defstringchar^^dc\defstringchar^^dd\defstringchar^^de\defstringchar^^df%
+ %
+ \defstringchar^^e0\defstringchar^^e1\defstringchar^^e2\defstringchar^^e3%
+ \defstringchar^^e4\defstringchar^^e5\defstringchar^^e6\defstringchar^^e7%
+ \defstringchar^^e8\defstringchar^^e9\defstringchar^^ea\defstringchar^^eb%
+ \defstringchar^^ec\defstringchar^^ed\defstringchar^^ee\defstringchar^^ef%
+ %
+ \defstringchar^^f0\defstringchar^^f1\defstringchar^^f2\defstringchar^^f3%
+ \defstringchar^^f4\defstringchar^^f5\defstringchar^^f6\defstringchar^^f7%
+ \defstringchar^^f8\defstringchar^^f9\defstringchar^^fa\defstringchar^^fb%
+ \defstringchar^^fc\defstringchar^^fd\defstringchar^^fe\defstringchar^^ff%
+}
+
+
+% define all the unicode characters we know about, for the sake of @U.
+\utfeightchardefs
+
+
% Make non-ASCII characters printable again for compatibility with
% existing Texinfo documents that may use them, even without declaring a
% document encoding.
%
{@catcode`- = @active
@gdef@normalturnoffactive{%
+ @nonasciistringdefs
@let-=@normaldash
@let"=@normaldoublequote
@let$=@normaldollar %$ font-lock fix
@c Local variables:
@c eval: (add-hook 'write-file-hooks 'time-stamp)
-@c page-delimiter: "^\\\\message"
+@c page-delimiter: "^\\\\message\\|emacs-page"
@c time-stamp-start: "def\\\\texinfoversion{"
@c time-stamp-format: "%:y-%02m-%02d.%02H"
@c time-stamp-end: "}"
Put point on the previous button.
@end table
-These commands are cyclic, e.g. when point is on the last button,
+These commands are cyclic, e.g., when point is on the last button,
pressing @kbd{n} moves it to the first button.
Typing @kbd{q} exits Todo Categories mode, killing the buffer and returning
@item F h
@itemx h
Hide the item headers if visible, or show them if they are hidden.
-With done items, only the done header (i.e. the done tag and date-time
+With done items, only the done header (i.e., the done tag and date-time
string inserted when the item was marked done) is hidden, the original
date-time string is not. With filtered items, the category (or
category-file) tag is not hidden.
This special method uses the Android Debug Bridge for accessing
Android devices. The Android Debug Bridge must be installed locally.
Some GNU/Linux distributions offer it for installation, otherwise it
-can be installed as part of the Android SDK. If the @command{adb}
+can be installed as part of the Android SDK@. If the @command{adb}
program is not found via the @env{PATH} environment variable, the
variable @var{tramp-adb-program} must point to its absolute path.
-Tramp does not connect Android devices to @command{adb}. This must be
-performed outside @value{emacsname}. If there is exactly one Android
-device connected to @command{adb}, a host name is not needed in the
-remote file name. The default @value{tramp} name to be used is
-@file{@trampfn{adb, , ,}} therefore. Otherwise, one could find
-potential host names with the command @command{adb devices}.
+@value{tramp} does not connect Android devices to @command{adb},
+unless the customer option @option{tramp-adb-connect-if-not-connected}
+is non-@code{nil}. If there is exactly one Android device connected
+to @command{adb}, a host name is not needed in the remote file name.
+The default @value{tramp} name to be used is @file{@trampfn{adb, , ,}},
+therefore. Otherwise, one could find potential host names with the
+command @command{adb devices}.
Usually, the @command{adb} method does not need any user name. It
runs under the permissions of the @command{adbd} process on the
devices, especially with unrooted ones. In that case, an error
message is displayed.
+If a device shall be connected via TCP/IP, it is possible to declare
+the port number to be used like @file{device#42}. Without a port
+number, the default value as declared in @command{adb} will be used.
+Port numbers are not applicable to Android devices connected via USB.
+
@end table
@end table
+@vindex tramp-gvfs-methods
@defopt tramp-gvfs-methods
This customer option, a list, defines the external methods which shall
be used with GVFS@. Per default, these are @option{dav},
@vindex tramp-default-proxies-alist
@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
+host to pass through, via the customer option
+@option{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
@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.
+This customer option keeps a list of regular expressions, which denote
+hosts running a registered shell like @command{rbash}. Those hosts
+can be used as proxies only.
If the bastion host from the example above runs a restricted shell,
you shall apply
@vindex tramp-own-remote-path
@defopt tramp-remote-path
When @value{tramp} connects to the remote host, it searches for the
-programs that it can use. The variable @code{tramp-remote-path}
-controls the directories searched on the remote host.
+programs that it can use. The customer option
+@option{tramp-remote-path} controls the directories searched on the
+remote host.
By default, this is set to a reasonable set of defaults for most
hosts. The symbol @code{tramp-default-remote-path} is a place
on Debian GNU/Linux this is @file{/bin:/usr/bin}, whereas on Solaris
this is @file{/usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin}.
It is recommended to apply this symbol on top of
-@code{tramp-remote-path}.
+@option{tramp-remote-path}.
It is possible, however, that your local (or remote ;) system
administrator has put the tools you want in some obscure local
@noindent
with @samp{192.168.0.1} being the IP address of your remote host
(@pxref{Predefined connection information}).
+
@end table
remote directory contents are reread regularly in order to detect such
changes, which would be invisible otherwise (@pxref{Connection caching}).
+@vindex tramp-completion-reread-directory-timeout
@defopt tramp-completion-reread-directory-timeout
-This variable defines the number of seconds since last remote command
-before rereading a directory contents. A value of 0 would require an
-immediate reread during file name completion, @code{nil} means to use
-always cached values for the directory contents.
+This customer option defines the number of seconds since last remote
+command before rereading a directory contents. A value of 0 would
+require an immediate reread during file name completion, @code{nil}
+means to use always cached values for the directory contents.
@end defopt
@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.
+persistently in @option{tramp-default-proxies-alist}. That means,
+those definitions are available also for future @value{emacsname}
+sessions.
@end defopt
@c In the Tramp GIT, 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.11
+@set trampver 2.2.12-pre
@c Other flags from configuration
@set instprefix /usr/local
pair of information (in lisp parlance, a @emph{cons cell}), where the
first part is a @dfn{syntactic symbol}, and the second part is a
@dfn{relative buffer position}. Syntactic symbols describe elements of
-VHDL code, e.g. @code{statement}, @code{comment}, @code{block-open},
+VHDL code, e.g., @code{statement}, @code{comment}, @code{block-open},
@code{block-close}, etc. @xref{Syntactic Symbols}, for a complete list
of currently recognized syntactic symbols and their semantics. Also,
the variable @code{vhdl-offsets-alist} contains the list of currently
visited, VHDL Mode will automatically institute these offsets using
@code{vhdl-set-offset}. @xref{Customizing Indentation}.
-Note that file style settings (i.e. @code{vhdl-file-style}) are applied
-before file offset settings (i.e. @code{vhdl-file-offsets}).
+Note that file style settings (i.e., @code{vhdl-file-style}) are applied
+before file offset settings (i.e., @code{vhdl-file-offsets}).
@node Advanced Customizations
@cindex region
-Vi operators like @kbd{d}, @kbd{c} etc. are usually used in combination
+Vi operators like @kbd{d}, @kbd{c} etc.@: are usually used in combination
with motion commands. It is now possible to use current region as the
argument to these operators. (A @dfn{region} is a part of buffer
delimited by point and mark.) The key @kbd{r} is used for this purpose.
@cindex Ex style motion
@cindex line editor motion
-Viper can be set free from the line--limited movements in Vi, such as @kbd{l}
+Viper can be set free from the line-limited movements in Vi, such as @kbd{l}
refusing to move beyond the line, @key{ESC} moving one character back,
etc. These derive from Ex, which is a line editor. If your
Viper customization file contains
@code{man} behavior.]
@item woman-ignore
-A boolean value. If non-@code{nil} then unrecognized requests etc. are
+A boolean value. If non-@code{nil} then unrecognized requests etc.@: are
ignored. Default is @code{t}. This gives the standard @code{roff} behavior.
If @code{nil} then they are left in the buffer, which may aid debugging.
their public spirit, we list here in alphabetical order a condensed
list of their contributions.
-Aaron Ecay: changed nsterm.m
+Aaron Ecay: changed ob-R.el ob-core.el org-src.el ox-latex.el nsterm.m
+ ob-awk.el ob-exp.el ob-python.el ob-tangle.el org-bibtex.el org-id.el
+ org.el org.texi paren.el
Aaron Larson: co-wrote bibtex.el
-Aaron S. Hawley: changed files.texi morse.el tar-mode.el add-log.el
- autoinsert.el building.texi custom.texi files.el glossary.texi
- isearch.el jka-cmpr-hook.el misc.texi re-builder.el sgml-mode.el
- texinfo.el thingatpt.el tutorial.el
+Aaron S. Hawley: wrote undo-tests.el
+and changed simple.el files.texi isearch.el morse.el sgml-mode.el
+ tar-mode.el thingatpt.el add-log.el autoinsert.el building.texi calc.el
+ cc-fonts.el comint.el compare-w.el custom.texi diff.el edebug.el
+ etags.el ffap.el files.el flyspell.el and 28 other files
-Abraham Nahum: changed configure.in dgux4.h sysdep.c
+Abdó Roig-Maranges: changed org.el org-agenda.el ox-html.el ox-odt.el
+
+Abraham Nahum: changed configure.ac dgux4.h sysdep.c
Abramo Bagnara: changed term.c
-Achim Gratz: changed org-clock.el org.el org.texi ob-ref.el ob.el
- org-macs.el
+Achim Gratz: changed org.el org-compat.el org.texi org-clock.el
+ ob-core.el ob-exp.el ob.el ob-perl.el ob-tangle.el org-agenda.el
+ org-macs.el org-table.el ob-C.el ob-R.el ob-eval.el ob-fortran.el
+ ob-python.el ob-ref.el ob-sh.el org-element.el org-exp-blocks.el
+ and 22 other files
-Adam Gołębiowski: changed Makefile.in
+Adam Gołębiowski: changed lib-src/Makefile.in
Adam Hupp: changed emacs.py emacs2.py emacs3.py gud.el
progmodes/python.el
-Adam Sjøgren: changed spam.el blink.xpm braindamaged.xpm cry.xpm dead.xpm
- evil.xpm forced.xpm frown.xpm grin.xpm indifferent.xpm
- reverse-smile.xpm sad.xpm smile.xpm wry.xpm xterm.c gnus-html.el
- gnus-start.el gnus-sum.el gnus.el gtkutil.c shr.el xterm.h
+Adam Sjøgren: changed mml2015.el spam.el shr.el xterm.c blink.xpm
+ braindamaged.xpm cry.xpm dead.xpm evil.xpm forced.xpm frown.xpm
+ grin.xpm gtkutil.c indifferent.xpm message.el reverse-smile.xpm sad.xpm
+ smile.xpm wry.xpm gnus-html.el gnus-spec.el and 5 other files
+
+Adam Sokolnicki: changed ruby-mode.el
-Adam Spiers: changed calendar.el
+Adam Spiers: changed org.texi calendar.el cus-edit.el org-clock.el
+ ox-html.el
Adam W: changed mail-source.el
Adrian Lanz: changed mail-source.el spam.el
Adrian Robert: co-wrote ns-win.el
-and changed nsterm.m nsfns.m nsfont.m nsterm.h Makefile.in nsmenu.m
- configure.in README config.in emacs.c font.c keyboard.c nsgui.h
- nsimage.m xdisp.c image.c lisp.h macos.texi menu.c Info-gnustep.plist
- darwin.h and 82 other files
+and changed nsterm.m nsfns.m nsfont.m nsterm.h nsmenu.m configure.ac
+ src/Makefile.in macos.texi README emacs.c font.c keyboard.c nsgui.h
+ nsimage.m xdisp.c image.c lib-src/Makefile.in lisp.h menu.c Makefile.in
+ darwin.h and 78 other files
Ævar Arnfjörð Bjarmason: changed rcirc.el
Agustín Martín: changed ispell.el flyspell.el fixit.texi
+Aidan Gauland: wrote em-tramp.el
+and changed eshell.texi em-term.el em-unix.el erc-match.el
+ automated/eshell.el em-cmpl.el em-dirs.el em-ls.el em-script.el
+ esh-proc.el
+
Aidan Kehoe: changed ipa.el lread.c mm-util.el erc-log.el erc.el
gnus-sum.el gnus-util.el latin-ltx.el nnfolder.el ob-tangle.el
objects.texi
Ake Stenhoff: co-wrote imenu.el
and changed cc-mode.el perl-mode.el
+Akinori Musha: changed ruby-mode.el Makefile.in sieve-mode.el
+
Aki Vehtari: changed bibtex.el gnus-art.el gnus-score.el gnus-sum.el
nnmail.el tar-mode.el
-Akinori Musha: changed ruby-mode.el
-
Alakazam Petrofsky: changed hanoi.el
Alan Mackenzie: wrote cc-awk.el
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-subword.el display.texi os.texi
- search.texi startup.el subr.el text.texi INSTALL.REPO add-log.el
- buffers.texi bytecomp.el callint.c cc-fix.el and 22 other files
+and changed cc-mode.texi lread.c programs.texi font-lock.el isearch.el
+ display.texi font-core.el lisp.el modes.texi search.texi cc-menus.el
+ cc-subword.el easy-mmode.el os.texi startup.el subr.el syntax.c
+ text.texi INSTALL.REPO add-log.el buffers.texi and 32 other files
+
+Alan Schmitt: changed gnus-sum.el nnimap.el ob-ocaml.el org-faces.el
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
Alastair Burt: changed gnus-art.el smiley.el
+Albert Krewinkel: co-wrote sieve-manage.el
+and changed sieve.el gnus-msg.el gnus.texi message.el sieve.texi
+
Albert L. Ting: changed gnus-group.el mail-hist.el
Aleksei Gusev: changed progmodes/compile.el
-Alex Coventry: changed files.el
-
-Alex Ott: changed TUTORIAL.ru ru-refcard.tex ispell.el ru-refcard.ps
-
-Alex Rezinsky: wrote which-func.el
-
-Alex Schroeder: wrote ansi-color.el cus-theme.el erc-compat.el
- erc-hecomplete.el erc-join.el erc-lang.el erc-ring.el master.el
- spam-stat.el sql.el
-and co-wrote longlines.el mail/rmailmm.el
-and changed erc.el erc-track.el erc-button.el erc-stamp.el erc-match.el
- erc-autoaway.el erc-nickserv.el rcirc.texi erc-autojoin.el erc-fill.el
- erc-pcomplete.el erc-complete.el erc-ibuffer.el erc-members.el rmail.el
- comint.el custom.el erc-bbdb.el erc-chess.el erc-ezbounce.el
- erc-imenu.el and 32 other files
-
-Alex Shinn: changed files.el
-
Alexander Becher: changed vc-annotate.el
+Alexander Haeckel: changed getset.el
+
Alexander Klimov: changed files.el calc-graph.el files.texi man.el rx.el
sendmail.el
Alexander Shopov: changed code-pages.el
+Alexander Vorobiev: changed org-compat.el
+
Alexander Zhuckov: changed ebrowse.c
Alexandre Julliard: wrote vc-git.el
Alexandru Harsanyi: wrote soap-client.el soap-inspect.el
and changed emacs3.py vc-hooks.el vc.el xml.el
+Alex Coventry: changed files.el
+
+Alex Kosorukoff: changed org-capture.el
+
+Alex Ott: changed TUTORIAL.ru ede/files.el ru-refcard.tex base.el
+ cedet-files.el cpp-root.el ede.el ede/generic.el idle.el ispell.el
+ semantic/format.el
+
+Alex Reed: changed verilog-mode.el
+
+Alex Rezinsky: wrote which-func.el
+
+Alex Schroeder: wrote ansi-color.el cus-theme.el erc-compat.el
+ erc-hecomplete.el erc-join.el erc-lang.el erc-ring.el master.el
+ spam-stat.el sql.el
+and co-wrote longlines.el mail/rmailmm.el
+and changed erc.el erc-track.el erc-button.el erc-stamp.el erc-match.el
+ erc-autoaway.el erc-nickserv.el rcirc.texi Makefile erc-autojoin.el
+ erc-fill.el erc-pcomplete.el erc-complete.el erc-ibuffer.el
+ erc-members.el rmail.el comint.el custom.el erc-bbdb.el erc-chess.el
+ erc-ezbounce.el and 35 other files
+
+Alex Shinn: changed files.el
+
Alfred Correira: changed generic-x.el
Alfred M. Szmidt: changed html2text.el openbsd.h progmodes/compile.el
Alfredo Finelli: changed TUTORIAL.it
-Ali Bahrami: changed configure configure.in sol2-10.h
+Ali Bahrami: changed configure configure.ac sol2-10.h
Alin C. Soare: changed lisp-mode.el hexl.el
Alon Albert: wrote rcompile.el
-Alp Aker: changed nsfont.m nsterm.h nsterm.m buff-menu.el configure.in
- nsfns.m nsmenu.m
+Alp Aker: changed nsfont.m nsterm.m buff-menu.el nsfns.m nsmenu.m
+ nsterm.h configure.ac macfont.m mule-cmds.el nsselect.m window.el
+
+Álvar Ibeas: changed TUTORIAL.es
+
+Álvar Jesús Ibeas Martín: changed emacs-lisp-intro.texi
Ami Fischman: changed bindings.el calendar.el diary-lib.el print.c
savehist.el vc-git.el
Anders Holst: wrote hippie-exp.el
-Anders Lindgren: wrote autorevert.el cwarn.el follow.el
-and changed font-lock.el etags.c compile.el nsfont.m nsterm.m
+Anders Lindgern: changed nsterm.m
-Andre Spiegel: changed vc.el vc-hooks.el vc-cvs.el vc-rcs.el vc-sccs.el
- files.el dired.el files.texi cperl-mode.el ediff-util.el log-view.el
- parse-time.el startup.el tramp-vc.el vc-arch.el vc-mcvs.el vc-svn.el
- vcdiff viper-util.el
+Anders Lindgren: wrote autorevert.el cwarn.el follow.el
+and changed font-lock.el nsterm.m etags.c compile.el ert.el nsfont.m
+ nsterm.h
-Andre Srinivasan: changed gnus-group.el gnus-sum.el gnus.texi message.el
- mm-decode.el mml.el nnmail.el
+Andrea Rossetti: changed ruler-mode.el
Andrea Russo: changed erc-dcc.el info-look.el
+Andreas Amann: changed emacsclient.c
+
Andreas Burtzlaff: changed org.el
Andreas Büsching: changed emacsclient.c
Andreas Jaeger: changed gnus-msg.el gnus-start.el gnus-xmas.el
nnfolder.el nnml.el
-Andreas Leha: changed ob.el
+Andreas Leha: changed ob-latex.el ob.el
Andreas Leue: changed artist.el
Andreas Luik: changed xfns.c xterm.c
-Andreas Politz: changed editfns.c elp.el ido.el outline.el term.el
+Andreas Politz: changed editfns.c elp.el frame.c ibuffer.el ido.el
+ imenu.el modes.texi outline.el sql.el subr.el term.el
Andreas Rottmann: changed emacsclient.1 emacsclient.c misc.texi server.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 577 other files
+Andreas Schwab: changed configure.ac lisp.h process.c xdisp.c alloc.c
+ coding.c Makefile.in files.el keyboard.c fileio.c xterm.c editfns.c
+ emacs.c src/Makefile.in fns.c lread.c print.c eval.c font.c xfns.c
+ sysdep.c and 633 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
- url-http.el xterm.c battery.el comint.el easy-mmode.el gmm-utils.el
- gnus-art.el gnus-cite.el gnus-draft.el gnus-group.el gnus-ml.el
- and 7 other files
+ gnus.el gnus-srvr.el gnus-util.el mm-url.el mm-uu.el url-http.el
+ xterm.c battery.el comint.el easy-mmode.el gmm-utils.el gnus-art.el
+ gnus-cite.el gnus-draft.el gnus-group.el gnus-ml.el gnus-msg.el
+ and 6 other files
Andreas Vögele: changed pgg-def.el
+Andrei Chițu: changed icalendar.el
+
+Andre Spiegel: changed vc.el vc-hooks.el vc-cvs.el vc-rcs.el vc-sccs.el
+ files.el dired.el files.texi cperl-mode.el ediff-util.el log-view.el
+ parse-time.el startup.el tramp-vc.el vc-arch.el vc-mcvs.el vc-svn.el
+ vcdiff viper-util.el
+
+Andre Srinivasan: changed gnus-group.el gnus-sum.el gnus.texi message.el
+ mm-decode.el mml.el nnmail.el
+
+Andrew Beals: changed spook.lines
+
Andrew Choi: changed macterm.c darwin.h mac-win.el sysdep.c emacs.c mac.c
macfns.c fontset.c frame.c keyboard.c xfaces.c dispextern.h macmenu.c
- unexmacosx.c Makefile.in configure.in frame.h macterm.h titdic-cnv.el
- xdisp.c alloc.c and 26 other files
+ unexmacosx.c configure.ac frame.h macterm.h titdic-cnv.el xdisp.c
+ alloc.c callproc.c and 26 other files
Andrew Cohen: wrote spam-wash.el
-and changed nnir.el gnus-sum.el nnimap.el gnus.texi gnus-group.el
- gnus-int.el dns.el gnus-art.el gnus-registry.el gnus-srvr.el gnus.el
- nnheader.el nnspool.el
+and changed nnir.el gnus-sum.el nnimap.el gnus-msg.el gnus.texi
+ gnus-group.el gnus-int.el dns.el gnus-art.el gnus-registry.el
+ gnus-srvr.el gnus.el nnheader.el nnspool.el
Andrew Csillag: wrote m4-mode.el
Andrew Hall: changed paren.el
-Andrew Innes: changed makefile.w32-in makefile.nt w32fns.c w32term.c
- w32.c w32proc.c fileio.c gmake.defs w32-fns.el dos-w32.el ms-w32.h
- nmake.defs w32term.h makefile.def unexw32.c w32menu.c w32xfns.c addpm.c
- cmdproxy.c emacs.c w32-win.el and 137 other files
+Andrew Hyatt: changed org-archive.el org.el org.texi
+
+Andrew Innes: changed makefile.nt w32fns.c w32term.c w32.c w32proc.c
+ makefile.w32-in fileio.c gmake.defs leim/makefile.w32-in
+ lib-src/makefile.w32-in w32-fns.el dos-w32.el inc/ms-w32.h nmake.defs
+ nt/makefile.w32-in src/makefile.w32-in w32term.h makefile.def unexw32.c
+ w32menu.c w32xfns.c and 139 other files
-Andrew Oram: changed calendar.texi (and other files in man/)
+Andrew Oram: changed calendar.texi (and other doc files)
Andrew Schein: changed sql.el
+Andrew W. Nosenko: changed tramp.el
+
Andrew Zhilin: changed emacs22.png emacs22.ico
+Andrey Kotlarski: changed eww.el eww.texi
+
Andrey Slusar: changed gnus-async.el gnus.el
Andrey Zhdanov: changed gud.el
-Andy Moreton: changed makefile.w32-in
+Andrzej Lichnerowicz: wrote ob-io.el ob-scala.el
+
+Andy Moreton: changed emacs/makefile.w32-in gnutls.c
Andy Norman: wrote ange-ftp.el
Andy Petrusenco: changed w32term.c
+Andy Sawyer: changed saveplace.el
+
Andy Seaborne: changed keyboard.c
Andy Stewart: wrote org-w3m.el
Antoine Levitt: changed gnus-group.el gnus-sum.el message.texi ada-prj.el
ange-ftp.el cus-edit.el dired-x.el ebnf2ps.el emerge.el erc-button.el
- erc-goodies.el erc-track.el files.el find-file.el gnus-art.el
- gnus-uu.el gnus.el gnus.texi message.el mh-funcs.el mh-mime.el
- and 7 other files
+ erc-goodies.el erc-stamp.el erc-track.el files.el find-file.el
+ gnus-art.el gnus-uu.el gnus.el gnus.texi message.el mh-funcs.el
+ and 8 other files
-Ari Roponen: changed atimer.c doc.c mule.texi startup.el time-date.el
+Ari Roponen: changed atimer.c doc.c hash.texi mule.texi package.el
+ startup.el time-date.el
Arisawa Akihiro: changed characters.el coding.c epa-file.el japan-util.el
language/tibetan.el message.el mm-decode.el mm-view.el ps-print.el
Arne Georg Gleditsch: changed gnus-sum.el
Arne Jørgensen: wrote latexenc.el
-and changed smime.el mml-smime.el smime-ldap.el gnus-art.el gnus-sieve.el
- ldap.el message.el mm-decode.el mml-sec.el mml.el mule-conf.el
- nnimap.el nnrss.el wid-edit.el
+and changed smime.el mml-smime.el smime-ldap.el flymake.el gnus-art.el
+ gnus-sieve.el ldap.el message.el mm-decode.el mml-sec.el mml.el
+ mule-conf.el nnimap.el nnrss.el wid-edit.el
-Arni Magnusson: changed ada-mode.texi frames.texi texinfo.el
+Arni Magnusson: wrote bat-mode.el
+and changed ada-mode.texi frames.texi generic-x.el texinfo.el
Artem Chuprina: changed message.el
+Artur Malabarba: wrote let-alist.el
+and changed package.el bindings.el newcomment.el package-test.el
+ desktop.el doc-view.el ido.el image-mode.el isearch.el package-x.el
+ simple.el
+
+Arun Persaud: changed org-agenda.el org-src.el
+
Ashwin Ram: wrote refer.el
+Atsuo Ohki: changed lread.c
+
Aubrey Jaffer: changed info.el unexelf.c
+Aurélien Aptel: changed cus-face.el dispextern.h display.texi faces.el
+ nsterm.m ox-html.el url.texi w32term.c xfaces.c xterm.c
+
Axel Boldt: changed ehelp.el electric.el
B. Anyos: changed w32term.c
-Baoqiu Cui: wrote org-docbook.el
+Baoqiu Cui: changed org-docbook.el
Barry A. Warsaw: wrote assoc.el elp.el man.el regi.el reporter.el
supercite.el
cc-guess.el cc-langs.el cc-menus.el cc-mode.el cc-styles.el cc-vars.el
and changed c++-mode.el cplus-md1.el syntax.c syntax.h
-Barry Fishman: changed gnu-linux.h
+Barry Fishman: changed configure.ac gnu-linux.h image.c
+
+Barry O'Reilly: changed simple.el lisp.h undo-tests.el keyboard.c
+ markers.texi alloc.c bytecode.c casetab.c data.c eval.c fileio.c fw.el
+ idle.el insdel.c lread.c pulse.el search.c subr.el text.texi
+ timer-tests.el undo.c
-Bastien Guerry: wrote gnus-bookmark.el org-latex.el
+Bastien Guerry: wrote gnus-bookmark.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-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-mobile.el ob.el org-eshell.el bookmark.el info.el
- org-attach.el and 36 other files
+and changed org.el org-agenda.el org.texi ox-html.el org-clock.el
+ org-capture.el org-table.el ox-latex.el ox.el ox-odt.el org-compat.el
+ ox-publish.el ob.el org-mobile.el org-colview.el org-macs.el
+ org-pcomplete.el org-timer.el org-faces.el ox-ascii.el org-archive.el
+ and 116 other files
Ben A. Mesander: co-wrote erc-dcc.el
-Ben Harris: changed configure.in
-
-Ben Key: changed w32.c w32fns.c w32menu.c configure.bat makefile.w32-in
- INSTALL gmake.defs nmake.defs w32.h w32term.c configure.in emacs.c
- keyboard.c make-docfile.c ms-w32.h nsfont.m nsterm.m sound.c xfaces.c
-
-Ben Menasha: changed nnmh.el
-
-Ben North: changed outline.el buffer.c fill.el isearch.el lisp-mode.el
- paren.el w32term.c xfaces.c
-
Bengt Martensson: co-wrote bibtex.el
+Ben Harris: changed configure.ac
+
Benjamin Andresen: wrote ob-screen.el
Benjamin Drieu: wrote pong.el
-and changed org-clock.el
+and changed org-clock.el org.el
-Benjamin Riefenstahl: changed w32select.c emacs.c lisp.h mac-win.el
- macterm.c ms-w32.h mule-cmds.el runemacs.c tcl.el w32.c w32.h
+Benjamin Riefenstahl: changed w32select.c emacs.c inc/ms-w32.h lisp.h
+ mac-win.el macterm.c mule-cmds.el runemacs.c tcl.el w32.c w32.h
Benjamin Rutt: co-wrote gnus-dired.el
and changed vc.el gnus-msg.el message.el diff-mode.el ffap.el nnimap.el
nnmbox.el simple.el vc-cvs.el
+Ben Key: changed w32.c w32fns.c w32menu.c configure.bat INSTALL
+ gmake.defs nmake.defs src/makefile.w32-in w32.h w32term.c configure.ac
+ emacs.c inc/ms-w32.h keyboard.c lib-src/makefile.w32-in make-docfile.c
+ nsfont.m nsterm.m sound.c xfaces.c
+
+Ben Menasha: changed nnmh.el
+
+Ben North: changed outline.el buffer.c fill.el isearch.el lisp-mode.el
+ paren.el w32term.c xfaces.c
+
Bernhard Herzog: changed vc-hg.el menu.c xsmfns.c
Bernt Hansen: changed org-agenda.el org-clock.el org.el org-capture.el
- org-html.el org-indent.el org.texi
+ org-indent.el org-macs.el org.texi ox-html.el
Bill Atkins: changed wdired.el
Bill Carpenter: wrote feedmail.el (public domain)
Bill Mann: wrote perl-mode.el
-and changed configure.in unexaix.c ibmrs6000.h usg5-4-3.h
+and changed configure.ac unexaix.c ibmrs6000.h usg5-4-3.h
Bill Pringlemeir: changed messcompat.el
Bill Richter: changed fill.el quail.el ccl.el encoded-kb.el fontset.el
- kinsoku.el kkc.el mule-cmds.el mule-conf.el mule-util.el mule.el
+ international/mule-util.el kinsoku.el kkc.el mule-cmds.el mule-conf.el
+ mule.el
Bill Rozas: wrote scheme.el
and changed xscheme.el
mh-folder.el mh-funcs.el mh-letter.el mh-mime.el mh-scan.el mh-seq.el
mh-show.el mh-utils.el mh-xface.el
and co-wrote mh-junk.el
-and changed mh-customize.el mh-search.el mh-alias.el mh-identity.el
- mh-e.texi mh-speed.el mh-init.el mh-acros.el mh-gnus.el mh-unit.el
- mh-inc.el mh-xemacs-compat.el mh-print.el Makefile.in image.el
- mh-tool-bar.el mh-xemacs.el README display.texi makefile.w32-in
- mh-pick.el and 86 other files
-
-Bjorn Solberg: changed nnimap.el
+and changed mh-customize.el mh-search.el mh-alias.el Makefile mh-e.texi
+ mh-identity.el README mh-speed.el mh-init.el mh-acros.el mh-gnus.el
+ mh-unit.el mh-inc.el mh-xemacs-compat.el mh-print.el lisp/Makefile.in
+ image.el mh-tool-bar.el mh-xemacs.el display.texi makefile.w32-in
+ and 86 other files
Björn Lindström: changed rcirc.texi
+Bjørn Mork: changed nnimap.el gnus-agent.el message.el mml2015.el
+
+Bjorn Solberg: changed nnimap.el
+
Björn Torkelsson: changed gnus-art.el gnus-group.el gnus-srvr.el
gnus-sum.el gnus-mlspl.el gnus-msg.el message.el gnus-agent.el
gnus-cus.el gnus-gl.el gnus-nocem.el gnus-score.el gnus-topic.el
gnus.el mail-source.el nnmail.el
-Bjørn Mork: changed nnimap.el gnus-agent.el message.el mml2015.el
-
Bob Glickstein: wrote sregex.el
and changed isearch.el sendmail.el
Boris Goldowsky: wrote avoid.el descr-text.el enriched.el facemenu.el
format.el shadowfile.el
and changed fill.el simple.el indent.el paragraphs.el cmds.c intervals.c
- intervals.h add-log.el cc-mode.el enriched.doc fileio.c make-mode.el
+ intervals.h add-log.el cc-mode.el enriched.txt fileio.c make-mode.el
text-mode.el textprop.c ada.el allout.el awk-mode.el bibtex.el buffer.c
buffer.h c-mode.el and 38 other files
-Boris Samorodov: changed imap.el
+Boyd Lynn Gerber: changed configure.ac
-Boyd Lynn Gerber: changed configure.in
+Bozhidar Batsov: changed ruby-mode.el subr-x.el subr.el bytecomp.el
+ comint.el lisp-mode.el package.el progmodes/python.el prolog.el
+ ruby-mode-tests.el scheme.el
Brad Howes: changed gnus-demon.el
Brent Goodrick: changed abbrev.el
-Brian Cully: changed ns-emacs.texi
+Brian Cully: changed macos.texi
Brian D. Carlstrom: changed gud.el smtpmail.el
-Brian Fox: changed Makefile.in Makefile configure.in minibuf.c dired.el
- files.el rmail.el search.c simple.el sysdep.c compile.el forms.texi
- frame.c info.texi keyboard.c make-dist subr.el systty.h texindex.c
- xterm.c ymakefile and 46 other files
+Brian Fox: changed Makefile.in Makefile configure.ac minibuf.c dired.el
+ files.el lib-src/Makefile.in oldXMenu/Makefile.in rmail.el search.c
+ simple.el sysdep.c compile.el forms.texi frame.c keyboard.c make-dist
+ subr.el systty.h texindex.c xterm.c and 47 other files
+
+Brian Jenkins: changed frame.c frames.texi hooks.texi
Brian Marick: co-wrote hideif.el
-Brian P Templeton: changed erc.el erc-compat.el erc-fill.el
- erc-nickserv.el erc-pcomplete.el erc-stamp.el erc-track.el
+Brian Mckenna: changed eww.el
Brian Palmer: changed erc.el erc-list.el
compare-w.el compile.el dabbrev.el debug.el diary.el diff.el dired.el
doctex.el doctor.el ebuff-menu.el echistory.el and 129 other files
+Brian P Templeton: changed erc.el erc-compat.el erc-fill.el
+ erc-nickserv.el erc-pcomplete.el erc-stamp.el erc-track.el lread.c
+ nsfont.m
+
Brian Sniffen: changed gnus-draft.el imap.el mm-decode.el
+Brian van den Broek: changed org.texi
+
+Bruno Félix Rezende Ribeiro: changed functions.texi
+
Bruno Haible: co-wrote po.el
and changed INSTALL emacs.1 epaths.in info.el paths.el
-Bryan Henderson: changed term.el
+Bryan Henderson: changed Makefile term.el
Bryan O'Sullivan: changed ange-ftp.el
+Caio Tiago Oliveira: changed ob-scala.el
+
Caleb Deupree: changed w32-fns.el
+Cameron Desautels: changed cus-edit.el custom.texi help.el regexp-opt.el
+ ruby-mode.el
+
Carl D. Roth: changed gnus-nocem.el
Carl Edman: co-wrote ns-win.el
Carsten Bormann: changed ibmrs6000.h latin-post.el
Carsten Dominik: wrote idlw-complete-structtag.el idlw-toolbar.el
- org-agenda.el org-archive.el org-ascii.el org-beamer.el org-capture.el
- org-clock.el org-colview.el org-compat.el org-datetree.el org-exp.el
- org-faces.el org-feed.el org-footnote.el org-html.el org-icalendar.el
- org-id.el org-indent.el org-info.el org-inlinetask.el org-install.el
- org-jsinfo.el org-macs.el org-mks.el org-mobile.el org-remember.el
- org-rmail.el org-table.el org-timer.el org-vm.el org-xoxo.el org.el
+ org-agenda.el org-archive.el org-capture.el org-clock.el org-colview.el
+ org-compat.el org-datetree.el org-faces.el org-feed.el org-footnote.el
+ org-id.el org-indent.el org-info.el org-inlinetask.el org-macs.el
+ org-mobile.el org-rmail.el org-table.el org-timer.el org.el
reftex-auc.el reftex-cite.el reftex-dcr.el reftex-global.el
reftex-index.el reftex-parse.el reftex-ref.el reftex-sel.el
reftex-toc.el reftex-vars.el reftex.el
and co-wrote idlw-help.el idlw-shell.el idlwave.el org-bbdb.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-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-src.el ox-beamer.el ox-html.el ox-icalendar.el
+and changed ox.el ox-latex.el org.texi org-remember.el orgcard.tex
+ ox-publish.el org-docbook.el ox-ascii.el org-attach.el org-protocol.el
+ org-mouse.el org-mac-message.el org-wl.el ox-jsinfo.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 and 24 other files
+ org-plot.el and 35 other files
-Caveh Jalali: changed configure.in intel386.h sol2-4.h
+Caveh Jalali: changed configure.ac intel386.h sol2-4.h
-Chad Brown: changed aix4-2.h bsd-common.h config.in configure.in cygwin.h
- dired.c gnu-linux.h mh-comp.el msdos.h sed2v2.inp sysdep.c usg5-4.h
+Chad Brown: changed aix4-2.h bsd-common.h configure.ac cygwin.h dired.c
+ gnu-linux.h mh-comp.el msdos.h sed2v2.inp sysdep.c usg5-4.h
Changwoo Ryu: changed files.el
Charles Hannum: changed aix3-1.h aix3-2.h configure ibmrs6000.h
keyboard.c netbsd.h pop.c sysdep.c systime.h systty.h xrdb.c
+Charles Rendleman: changed eww.el
+
Charles Sebold: changed org-plot.el
Charlie Martin: wrote autoinsert.el
Chong Yidong: wrote compile-tests.el dichromacy-theme.el
font-parse-tests.el redisplay-testsuite.el tabulated-list.el
+ xml-parse-tests.el
and co-wrote longlines.el tango-dark-theme.el tango-theme.el
-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 xterm.c emacs.texi misc.texi subr.el image.c
- mouse.el custom.texi xfns.c and 845 other files
+and changed simple.el display.texi xdisp.c files.el frames.texi
+ cus-edit.el files.texi custom.el subr.el text.texi faces.el keyboard.c
+ startup.el package.el misc.texi emacs.texi modes.texi mouse.el
+ custom.texi image.c window.el and 923 other files
Chris Chase: co-wrote idlw-shell.el idlwave.el
Chris Foote: changed progmodes/python.el
-Chris Gray: wrote org-special-blocks.el
-and changed mm-decode.el
+Chris Gray: changed mm-decode.el ox-html.el
Chris Hall: changed callproc.c frame.c
Chris Hanson: changed xscheme.el scheme.el xterm.c hpux.h x11term.c
- hp9000s300.h keyboard.c process.c texinfmt.el emacsclient.c sort.el
- syntax.c texnfo-upd.el x11fns.c xfns.c dired.el fileio.c hp9000s800.h
- indent.c info.el man.el and 17 other files
+ hp9000s300.h keyboard.c process.c texinfmt.el sort.el syntax.c
+ texnfo-upd.el x11fns.c xfns.c dired.el emacsclient.c fileio.c
+ hp9000s800.h indent.c info.el man.el and 17 other files
Chris Hecker: changed calc-aent.el
Chris Smith: wrote icon.el
and changed icon-mode.el
-Christian Egli: wrote org-taskjuggler.el
-and changed org.texi
+Christian Egli: changed org-taskjuggler.el org.texi
-Christian Faulhammer: changed Makefile.in configure configure.in
+Christian Faulhammer: changed configure configure.ac src/Makefile.in
vc-bzr.el
Christian Limpach: co-wrote ns-win.el
-and changed configure.in
+and changed configure.ac
Christian Lynbech: changed appt.el emacsserver.c tramp.el
Christian Millour: changed shell.el
-Christian Moe: changed org-bbdb.el org-html.el org-special-blocks.el
+Christian Moe: changed org-bbdb.el org-special-blocks.el ox-html.el
+ ox-odt.el
Christian Neukirchen: changed mm-util.el
-Christian Ohler: wrote ert-tests.el ert-x.el ert.el
-and changed Makefile.in automated configure.in ert-x-tests.el ert.texi
- makefile.w32-in
+Christian Ohler: wrote ert-tests.el ert.el
+and co-wrote ert-x.el
+and changed Makefile.in automated automated/Makefile.in configure.ac
+ ert-x-tests.el ert.texi misc/Makefile.in misc/makefile.w32-in
Christian Plate: changed nnmaildir.el sgml-mode.el
Christian von Roques: changed mml2015.el epg.el gnus-start.el
-Christoph Bauer: changed configure.in
-
-Christoph Conrad: changed gnus-agent.el gnus-score.el makefile.w32-in
- qp.el
+Christian Wittern: changed image-mode.el
-Christoph Scholtes: changed makefile.w32-in README.W32
- progmodes/python.el stdint.h INSTALL maintaining.texi zipdist.bat
- admin.el bookmark.el config.nt configure.bat control.texi cua-base.el
- gmake.defs help-mode.el help.el ido.el make-dist makedist.bat menu.c
- minibuf.c and 6 other files
+Christoph Bauer: changed configure.ac
-Christoph Wedler: wrote antlr-mode.el
-and changed format.el gnus-art.el gnus-picon.el message.el register.el
- smiley.el texinfmt.el
+Christoph Conrad: changed gnus-agent.el gnus-score.el
+ lib-src/makefile.w32-in qp.el
-Christophe Rhodes: changed org-exp.el
+Christoph Dittmann: changed ox-beamer.el
Christophe de Dinechin: co-wrote ns-win.el
+Christophe Deleuze: changed icalendar.el
+
+Christoph Egger: changed configure.ac
+
+Christophe Junke: changed org-agenda.el org.el
+
Christopher Allan Webber: changed gamegrid.el org-agenda.el tetris.el
-Christopher Genovese: changed assoc.el
+Christopher Genovese: changed assoc.el help-fns.el
+
+Christophe Rhodes: changed ox-latex.el ox.el
Christopher J. Madsen: wrote decipher.el
and changed replace.el files.el ispell.el time.el
Christopher Oliver: changed mouse.el
-Christopher Schmidt: changed ibuffer.el
+Christopher Schmidt: changed ibuffer.el org.el tips.texi calc-aent.el
+ calc.el calc.texi calendar.el cl-macs.el comint.el dired-x.el dired.el
+ files.el files.texi find-dired.el gnus-int.el gnus-msg.el gnus.texi
+ help-fns.el info.el locate.el lread.c and 14 other files
+
+Christoph Scholtes: changed README.W32 lib/makefile.w32-in
+ nt/makefile.w32-in progmodes/python.el stdint.h INSTALL
+ maintaining.texi src/makefile.w32-in zipdist.bat INSTALL.REPO admin.el
+ bookmark.el config.nt configure.bat control.texi cua-base.el gmake.defs
+ help-mode.el help.el ibuffer.el ido.el and 13 other files
-Christopher Suckling: co-wrote org-mac-message.el
+Christoph Wedler: wrote antlr-mode.el
+and changed format.el gnus-art.el gnus-picon.el message.el register.el
+ smiley.el texinfmt.el
+
+Chris Zheng: changed gnutls.c
Chuck Blake: changed term.c
Chunyu Wang: changed gnus-art.el pcl-cvs.texi
-Claudio Bley: changed makefile.w32-in process.c
+Claudio Bley: changed image.c image.el process.c src/makefile.w32-in
+ stat.h w32-win.el w32.c
-Claudio Fontana: changed Makefile.in
+Claudio Fontana: changed Makefile.in leim/Makefile.in lib-src/Makefile.in
Colin Marquardt: changed gnus.el message.el
Colin Walters: wrote ibuf-ext.el ibuf-macs.el ibuffer.el
and changed calc.el replace.el update-game-score.c calc-ext.el
- calc-misc.el Makefile.in calc-macs.el calc-mode.el calc-graph.el
- gamegrid.el calc-aent.el calc-bin.el calc-embed.el calc-keypd.el
- calc-math.el calc-prog.el calc-units.el calcalg2.el font-core.el
- info.el calc-alg.el and 78 other files
+ calc-misc.el calc-macs.el calc-mode.el calc-graph.el gamegrid.el
+ calc-aent.el calc-bin.el calc-embed.el calc-keypd.el calc-math.el
+ calc-prog.el calc-units.el calcalg2.el font-core.el info.el calc-alg.el
+ calc-arith.el and 80 other files
Colin Williams: changed calc.texi
+Constantin Kulikov: changed server.el startup.el
+
Courtney Bane: changed term.c
Craig Markwardt: changed icalendar.el
Craig McDaniel: changed sheap.c
-D. E. Evans: changed basic.texi
+Craig Tanis: changed ox-latex.el
Daiki Ueno: wrote epa-dired.el epa-file.el epa-hook.el epa-mail.el epa.el
epg-config.el epg.el pgg-def.el pgg-gpg.el pgg-parse.el pgg-pgp.el
pgg-pgp5.el pgg.el plstore.el sasl.el starttls.el
and co-wrote sasl-cram.el sasl-digest.el
-and changed mml2015.el mml1991.el epa.texi auth-source.el gnus.texi
- mm-uu.el mml-smime.el Makefile.in auth.texi gnus-sum.el mm-decode.el
- mm-view.el mml-sec.el mml.el dired.el dired.texi epa-file-hook.el
- epa-setup.el epg-package-info.el faces.el files.el and 17 other files
+and changed mml2015.el mml1991.el epa.texi auth-source.el mml-smime.el
+ mml.el package.el gnus.texi mm-decode.el mm-uu.el auth.texi gnus-sum.el
+ mm-view.el mml-sec.el archive-contents archive-contents.sig dbus.el
+ dired.el dired.texi epa-file-hook.el epa-setup.el and 32 other files
Dale Gulledge: changed TUTORIAL.eo
Dale R. Worley: wrote emerge.el (public domain)
and changed mail-extr.el
+Dale Sedivec: changed sgml-mode.el wisent/python.el
+
+Damien Cassou: changed info.el
+
Damien Elmes: changed erc.el erc-dcc.el erc-track.el erc-log.el
- erc-pcomplete.el erc-button.el erc-nets.el erc-ring.el erc-fill.el
- erc-match.el erc-members.el erc-nickserv.el
+ erc-pcomplete.el README erc-button.el erc-nets.el erc-ring.el Makefile
+ erc-fill.el erc-match.el erc-members.el erc-nickserv.el
Damon Anton Permezel: wrote hanoi.el (public domain)
spam.el time-date.el
Dan Davison: wrote ob-matlab.el ob-octave.el
-and co-wrote ob-R.el ob-exp.el ob-lob.el ob-perl.el ob-python.el
- ob-ref.el ob.el org-src.el
-and changed ob-sh.el org-exp.el org.el org-latex.el ob-tangle.el ob-C.el
+and co-wrote ob-R.el ob-core.el ob-exp.el ob-lob.el ob-perl.el
+ ob-python.el ob-ref.el org-src.el
+and changed ob.el ob-sh.el org.el ox.el ox-latex.el ob-tangle.el ob-C.el
ob-asymptote.el ob-clojure.el ob-haskell.el ob-ruby.el ob-scheme.el
ob-table.el ob-ditaa.el ob-dot.el ob-gnuplot.el ob-js.el ob-mscgen.el
- ob-ocaml.el ob-org.el ob-plantuml.el ob-sass.el and 13 other files
+ ob-ocaml.el ob-org.el ob-plantuml.el and 14 other files
-Dan Nicolaescu: wrote iris-ansi.el romanian.el vc-dir.el
-and co-wrote hideshow.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 918 other files
-
-Dan Rosenberg: changed movemail.c
-
-Dani Moncayo: changed buffers.texi lists.texi custom.texi dired.texi
- makefile.w32-in text.texi
+Daniel Bergey: changed indian.el
Daniel Brockman: changed cus-start.el format-spec.el ibuffer.el rcirc.el
-Daniel Clemente: changed generic-x.el org-html.el
+Daniel Clemente: changed generic-x.el ox-html.el
-Daniel Colascione: co-wrote js.el
-and changed cmdproxy.c subr.el syntax.el DEBUG cc-engine.el cus-start.el
- eval.c fns.c frames.texi imenu.el keyboard.c lisp.h nxml-mode.el
- nxml-rap.el nxml-util.el sh-script.el which-func.el
+Daniel Colascione: wrote finalizer-tests.el generator-tests.el
+ generator.el syntax-tests.el
+and co-wrote js.el
+and changed w32fns.c alloc.c emacs.c cl-macs.el image.c keyboard.c lisp.h
+ sh-script.el configure.ac cygw32.c process.c src/Makefile.in w32term.h
+ automated/cl-lib-tests.el cygw32.h dbusbind.c fns.c unexcw.c unexw32.c
+ w32.c w32term.c and 144 other files
-Daniel Dehennin: changed mml2015.el gnus-msg.el mm-decode.el
+Daniel Dehennin: changed mml2015.el gnus-mlspl.el gnus-msg.el
+ mm-decode.el ox.el
Daniel E. Doherty: changed calc.texi
-Daniel Elliott: changed octave-mod.el
+Daniel Elliott: changed octave.el
Daniel Engeler: changed sysdep.c elisp.texi emacs.texi internals.texi
misc.texi process.c process.h processes.texi term.el w32.c w32.h
-Daniel Hackney: changed emacsclient.c package.el process.c
+Daniel Hackney: wrote package-test.el
+and co-wrote package.el
+and changed package-x.el ange-ftp.el automated/Makefile.in
+ automated/package-test.el browse-url.el dbus.el dired-x.el
+ ediff-diff.el ediff-init.el ediff-merg.el ediff-mult.el ediff-util.el
+ ediff-wind.el ediff.el emacsclient.c emerge.el eudc.el eudcb-ldap.el
+ eww.el finder.el imap.el and 7 other files
Daniel Jensen: changed apropos.el
-Daniel Laliberte: wrote cl-specs.el cust-print.el edebug.el isearch.el
+Daniel Koning: changed artist.el commands.texi subr.el
+
+Daniel LaLiberte: wrote cust-print.el edebug.el isearch.el
and co-wrote hideif.el
and changed mlconvert.el eval-region.el
Daniel Schoepe: changed gnus-sum.el
+Dani Moncayo: changed Makefile.in msys-to-w32 configure.ac buffers.texi
+ lists.texi mini.texi nt/makefile.w32-in INSTALL README.W32 basic.texi
+ custom.texi dired.texi display.texi emacs-lisp-intro.texi killing.texi
+ make-dist mark.texi msysconfig.sh simple.el text.texi version.el
+ zipdist.bat
+
+Dan Nicolaescu: wrote iris-ansi.el romanian.el vc-dir.el
+and co-wrote hideshow.el
+and changed vc.el configure.ac vc-hg.el vc-git.el src/Makefile.in
+ 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 920 other files
+
Danny Roozendaal: wrote handwrite.el
Danny Siu: changed gnus-sum.el gnus-picon.el nndoc.el nnimap.el smiley.el
-Darren Hoo: changed db.el gnus-art.el
+Dan Rosenberg: changed movemail.c
+
+Darren Hoo: changed db-find.el db.el gnus-art.el isearch.el man.el
+ nsmenu.m startup.el
Darren Stalder: changed gnus-util.el
Darrin B. Jewell: changed etags.c lisp.h
+Dato Simó: changed network-stream.el
+
Dave Detlefs: co-wrote cc-align.el cc-cmds.el cc-defs.el cc-engine.el
cc-langs.el cc-menus.el cc-mode.el cc-styles.el cc-vars.el
+Dave Goldberg: changed message.el
+
Dave Lambert: changed sol2-5.h xfns.c xterm.c xterm.h
-Dave Love: wrote autoarg.el autoconf.el benchmark.el cap-words.el
- cfengine.el elide-head.el hl-line.el language/georgian.el
- latin1-disp.el progmodes/python.el quail/georgian.el refill.el
- rfc1345.el sgml-input.el smiley.el sym-comp.el tool-bar.el uni-input.el
- utf-7.el utf-8-lang.el vc/vc-bzr.el welsh.el
+Dave Love: wrote autoarg.el autoconf.el benchmark.el cfengine.el
+ elide-head.el hl-line.el language/georgian.el latin1-disp.el
+ quail/georgian.el refill.el rfc1345.el sgml-input.el smiley.el
+ sym-comp.el tool-bar.el uni-input.el utf-7.el utf-8-lang.el
+ vc/vc-bzr.el welsh.el
and co-wrote latin-ltx.el socks.el
-and changed Makefile.in configure.in help.el mule-cmds.el fortran.el
- mule-conf.el xterm.c browse-url.el mule.el coding.c european.el fns.c
- mule-diag.el simple.el wid-edit.el cus-edit.el cus-start.el files.el
- keyboard.c byte-opt.el info.el and 770 other files
+and changed configure.ac help.el mule-cmds.el fortran.el mule-conf.el
+ xterm.c browse-url.el mule.el coding.c src/Makefile.in european.el
+ fns.c mule-diag.el simple.el wid-edit.el cus-edit.el cus-start.el
+ files.el keyboard.c byte-opt.el info.el and 770 other files
Dave Pearson: wrote 5x5.el quickurl.el
-David A. Capello: changed etags.c
+David Abrahams: changed gnus-int.el gnus-sum.el nnimap.el
+ gnus-registry.el org-agenda.el auth-source.el coding.c cus-start.el
+ ediff-init.el ediff-util.el filelock.c gnus-range.el gnus-salt.el
+ gnus.texi mairix.el nnir.el nnmairix.el nnregistry.el org-clock.el
+ org.el
-David Abrahams: changed gnus-sum.el org-agenda.el coding.c ediff-init.el
- gnus-registry.el gnus.texi mairix.el nnimap.el nnir.el nnmairix.el
- nnregistry.el org-clock.el
+David A. Capello: changed etags.c
David Bakhash: wrote strokes.el
David Byers: changed minibuf.c
+David Cadé: changed mpc.el
+
+David Caldwell: changed unexmacosx.c
+
David Casperson: changed font-core.el menu-bar.el tex-mode.el
David De La Harpe Golden: changed files.el mouse.el simple.el fileio.c
cus-start.el nsselect.m select.el w32-fns.el x-win.el xterm.c
-David Edmondson: changed message.el gnus-cite.el imap.el mm-uu.el
- mm-view.el mml2015.el nnfolder.el nnimap.el nnml.el
+David Edmondson: changed message.el mml2015.el gnus-cite.el mm-uu.el
+ mm-view.el nnfolder.el nnimap.el nnml.el shr.el
David Engster: wrote mairix.el nnmairix.el
-and changed gnus.texi insert.el registry.el db-find.el gnus-msg.el
- analyze/complete.el base.el bovine-grammar.el cedet/srecode.el
- cpp-root.el db-typecache.el db.el dictionary.el display.texi
- document.el ede-grammar.el ede/custom.el ede/generic.el files.el
- filters.el gnus-registry.el and 23 other files
+and co-wrote gitmerge.el
+and changed cedet/semantic.el db.el insert.el semantic/complete.el c.by
+ c.el db-el.el db-find.el ede-grammar.el eieio-opt.el eieio.el
+ eieio.texi gnus.texi registry.el srecode/compile.el wisent/python.el
+ analyze.el bovine/el.el bovine/grammar.el db-file.el decorate/mode.el
+ and 85 other files
David Gillespie: wrote calc-aent.el calc-alg.el calc-arith.el calc-bin.el
calc-comb.el calc-cplx.el calc-embed.el calc-ext.el calc-fin.el
calc-prog.el calc-rewr.el calc-rules.el calc-sel.el calc-stat.el
calc-store.el calc-stuff.el calc-trail.el calc-undo.el calc-units.el
calc-vec.el calc-yank.el calc.el calcalg2.el calcalg3.el calccomp.el
- calcsel2.el cl-compat.el cl-extra.el cl-macs.el cl-seq.el cl.el cl.texi
- edmacro.el obsolete/complete.el
-and changed info.el bytecomp.el complete.el
+ calcsel2.el cl-compat.el cl-extra.el cl-macs.el cl-seq.el cl.texi
+ edmacro.el emacs-lisp/cl-lib.el obsolete/complete.el
+and changed info.el bytecomp.el cl.el complete.el
David Glasser: changed tar-mode.el
David Hull: changed vc-hg.el
-David Hunter: changed config.nt flymake.el ms-w32.h process.c
-
-David J. Biesack: changed antlr-mode.el
+David Hunter: changed config.nt flymake.el inc/ms-w32.h process.c
-David J. MacKenzie: changed configure.in etags.c Makefile.in fakemail.c
- movemail.c wakeup.c cvtmail.c qsort.c termcap.c yow.c Makefile avoid.el
- b2m.c config.in digest-doc.c emacsclient.c emacsserver.c emacstool.c
- etags-vmslib.c fortran.el hexl.c and 14 other files
+David J. Biesack: changed antlr-mode.el quickurl.el
-David Kastrup: changed quail/greek.el replace.el faq.texi search.c
- ange-ftp.el calc.el help.el keymaps.texi mouse.el subr.el woman.el
- Makefile.in desktop.el gnus-art.el keymap.c keymap.h lisp-mnt.el
- meta-mode.el mpuz.el process.c search.texi and 79 other files
+David J. MacKenzie: changed configure.ac Makefile.in etags.c fakemail.c
+ cvtmail.c movemail.c termcap.c wakeup.c yow.c Makefile avoid.el b2m.c
+ config.in digest-doc.c emacsclient.c emacsserver.c emacstool.c
+ etags-vmslib.c fortran.el hexl.c isearch.el and 14 other files
David Kågedal: wrote tempo.el
and changed sendmail.el xmenu.c
+David Kastrup: changed greek.el replace.el efaq.texi search.c subr.el
+ ange-ftp.el calc.el help.el keymaps.texi mouse.el woman.el desktop.el
+ gnus-art.el keymap.c keymap.h lisp-mnt.el meta-mode.el mpuz.el
+ process.c search.texi startup.el and 81 other files
+
David Lawrence: changed comint.el simple.el files.el c++-mode.el
- compile.el getdate.y inf-lisp.el shell.el emerge.el tex-mode.el
- c-mode.el cl.el dired.el emacs.1 emacsserver.c gnus.el history.el
- lisp-mode.el lisp.el mh-e.el rnews.el and 79 other files
+ compile.el inf-lisp.el shell.el emerge.el tex-mode.el c-mode.el cl.el
+ dired.el getdate.y gnus.el history.el lisp-mode.el lisp.el mh-e.el
+ rnews.el subr.el Makefile and 79 other files
David Lord: changed timeclock.el
-David M. Brown: wrote array.el
-
-David M. Koppelman: wrote hi-lock.el
-and changed display.texi
-
-David M. Smith: wrote ielm.el
-and changed imenu.el pgg-def.el xterm.c
+David Maus: changed org.el org-agenda.el ox.el org-feed.el org-wl.el
+ org-macs.el ox-html.el org-capture.el org.texi org-gnus.el org-bbdb.el
+ org-clock.el org-protocol.el ox-publish.el ob-haskell.el ob.el
+ org-bibtex.el org-compat.el org-footnote.el org-id.el org-list.el
+ and 20 other files
-David Maus: co-wrote org-wl.el
-and changed org.el org-agenda.el org-feed.el org-exp.el org-html.el
- org-macs.el org-capture.el org.texi org-gnus.el org-bbdb.el
- org-clock.el org-protocol.el org-publish.el ob-haskell.el ob.el
- org-bibtex.el org-compat.el org-footnote.el org-id.el org-latex.el
- org-list.el and 20 other files
+David M. Brown: wrote array.el
David McCabe: changed lisp-mode.el
David Michael: changed files.el
+David M. Koppelman: wrote hi-lock.el
+and changed display.texi
+
David Moore: co-wrote nnvirtual.el
and changed gnus-xmas.el
-David Mosberger-Tang: changed alpha.h unexelf.c cm.h config.in
- configure.in cvtmail.c data.c dispnew.c emacsserver.c etags.c
- fakemail.c keyboard.c mem-limits.h process.c profile.c sorted-doc.c
- sysdep.c terminfo.c unexelf1.c yow.c
+David Mosberger-Tang: changed alpha.h unexelf.c cm.h configure.ac
+ cvtmail.c data.c dispnew.c emacsserver.c etags.c fakemail.c keyboard.c
+ mem-limits.h process.c profile.c sorted-doc.c sysdep.c terminfo.c
+ unexelf1.c yow.c
+
+David M. Smith: wrote ielm.el
+and changed imenu.el pgg-def.el xterm.c
-David O'Toole: wrote org-publish.el
+David O'Toole: wrote ox-publish.el
and co-wrote ob-lisp.el
-David Ponce: wrote bovine-grammar.el cedet.el comp.el grammar-wy.el
- grammar.el java-tags.el mode-local.el recentf.el ruler-mode.el
+David Ponce: wrote bovine/grammar.el cedet.el comp.el java-tags.el
+ mode-local.el recentf.el ruler-mode.el semantic/grammar.el
semantic/java.el semantic/wisent.el senator.el tree-widget.el
- wisent-grammar.el wisent/wisent.el
+ wisent/grammar.el wisent/wisent.el
and co-wrote util-modes.el
and changed w32menu.c w32term.c close.png close.xpm empty.png empty.xpm
end-guide.png end-guide.xpm files.el guide.png guide.xpm handle.png
handle.xpm keyboard.c leaf.png leaf.xpm no-guide.png no-guide.xpm
- no-handle.png no-handle.xpm open.png and 20 other files
+ no-handle.png no-handle.xpm open.png and 22 other files
+
+David Raynes: changed ns-win.el
David Reitter: wrote mailclient.el
-and changed nsterm.m nsfns.m ns-win.el nsfont.m Makefile.in cus-start.el
- macos.texi menu-bar.el nsmenu.m simple.el commands.h cus-edit.el
+and changed nsterm.m nsfns.m ns-win.el nsfont.m cus-start.el macos.texi
+ menu-bar.el nsmenu.m simple.el Makefile.in commands.h cus-edit.el
easy-mmode.el emacsbug.el emacsclient.c faces.el flyspell.el info.el
- keyboard.c keymap.c macterm.c and 12 other files
+ keyboard.c keymap.c lib-src/Makefile.in and 15 other files
-David Robinow: changed makefile.w32-in w32inevt.c
+David Robinow: changed w32inevt.c lib-src/makefile.w32-in
+ lispintro/makefile.w32-in
David Robinson: changed menu-bar.el x-win.el
+David Röthlisberger: changed ido.el
+
David S. Goldberg: changed gnus-art.el message.el
David Vazquez: changed m4-mode.el
David Z. Maze: changed nnml.el nnrss.el
-Deanna Phillips: changed configure.in
+Davor Cubranic: changed nsterm.m
+
+Deanna Phillips: changed configure.ac
Debarshi Ray: changed erc-backend.el erc.el
org.el simple.el vc.el vhdl-mode.el wdired.el README ada-mode.el
allout.el appt.el apropos.el artist.el and 85 other files
+D. E. Evans: changed basic.texi
+
Denis B. Roegel: co-wrote solar.el
Denis Bueno: changed autorevert.el
Denis Stünkel: changed ibuf-ext.el
-Deniz Dogan: changed rcirc.el simple.el css-mode.el commands.texi
- image.el iswitchb.el lisp-mode.el process.c progmodes/python.el
- quickurl.el rcirc.texi vc/vc-bzr.el wdired.el window.el
+Deniz Dogan: changed rcirc.el simple.el css-mode.el TUTORIAL.sv
+ commands.texi erc-log.el erc.el image.el iswitchb.el lisp-mode.el
+ process.c progmodes/python.el quickurl.el rcirc.texi vc/vc-bzr.el
+ wdired.el window.el
Dennis Gilmore: changed sparc.h
Denys Duchier: changed pop3.el
-Derek Atkins: changed imap.el pgg-pgp.el
+Derek Atkins: changed pgg-pgp.el
Derek L. Davies: changed gud.el
Derek Upham: changed nxml-mode.el
Detlev Zundel: wrote re-builder.el
+and changed buffer.c
Devon Sean McCullough: changed comint.el url-http.el
-Dhruva Krishnamurthy: changed makefile.w32-in emacsclient.c fontset.c
- sound.c w32proc.c
+Dhruva Krishnamurthy: changed emacsclient.c fontset.c makefile.w32-in
+ misc/makefile.w32-in nt/makefile.w32-in sound.c w32proc.c
Diane Murray: changed erc.el erc-backend.el erc-menu.el erc-button.el
erc-track.el erc-match.el erc-nets.el erc-list.el erc-autoaway.el
erc-capab.el erc-nickserv.el erc-stamp.el erc-compat.el erc-fill.el
erc-goodies.el erc-ibuffer.el erc-log.el erc-nicklist.el url-http.el
- erc-dcc.el erc-networks.el and 35 other files
+ Makefile erc-dcc.el and 37 other files
Didier Verna: wrote gnus-diary.el nndiary.el
and co-wrote nnml.el
gnus.texi gnus-art.el gnus-srvr.el gnus-start.el gnus-topic.el
gnus-xmas.el gnus-picon.el gnus-salt.el cus-edit.el gnus-int.el
gnus-util.el message.texi nnmail.el rect.el cl-indent.el gmm-utils.el
- and 8 other files
+ and 10 other files
Dieter Schuster: changed etags.c
-Dima Kogan: changed hideshow.el
+Dima Kogan: changed hideshow.el autorevert.el erc-backend.el font.c
+ subword.el gud.el simple.el xfaces.c xgselect.c
Dirk Herrmann: co-wrote bibtex.el
-Dirk Ullrich: changed ispell.el
-
Dirk-Jan C. Binnema: changed org-agenda.el
+Dirk Ullrich: changed ispell.el
+
Dmitri Paduchikh: changed advice.el
-Dmitry Antipov: changed alloc.c keyboard.c buffer.c ccl.c editfns.c
- emacs.c fontset.c keymap.c lisp.h lread.c lwlib-Xaw.c lwlib-Xm.c
- lwlib-utils.c lwlib.c macmenu.c w32menu.c xdisp.c xlwmenu.c xmenu.c
+Dmitry Antipov: changed lisp.h alloc.c xdisp.c xterm.c buffer.c frame.c
+ window.c xfns.c font.c w32term.c frame.h keyboard.c nsterm.m w32fns.c
+ editfns.c xfaces.c xterm.h dispnew.c fileio.c dispextern.h fns.c
+ and 273 other files
Dmitry Bolshakov: changed hideshow.el
Dmitry Dzhus: changed gdb-mi.el gud.el fadr.el all.xpm building.texi
emacs.texi process.c thread.xpm
-Dmitry Gutov: changed lisp.el ruby-mode.el
+Dmitry Gorbik: changed org.el
+
+Dmitry Gutov: changed ruby-mode.el ruby-mode-tests.el xref.el ruby.rb
+ package.el vc-git.el log-edit.el package-test.el elisp-mode.el js.el
+ lisp.el menu-bar.el etags.el newcomment.el vc-svn.el vc.el
+ archive-contents automated/package-test.el find-func.el minibuffer.el
+ simple.el and 40 other files
Dmitry Kurochkin: changed isearch.el
Doug Cutting: co-wrote disass.el
+Douglas Lewan: changed TUTORIAL.pt_BR
+
Doug Maxey: changed mouse.el
Drake Wilson: changed emacsclient.c files.el misc.texi
Drew Adams: wrote light-blue-theme.el
and co-wrote color.el
-and changed cus-edit.el dired.el faces.el files.el info.el isearch.el
- menu-bar.el mouse.el ange-ftp.el bindings.el bookmark.el custom.el
- descr-text.el dired.texi etags.el finder.el frame.el help-fns.el
- help.el image-dired.el modes.texi and 7 other files
-
-E. Jay Berkenbilt: changed b2m.c flyspell.el ispell.el unrmail.el
- whitespace.el window.h
+and changed cus-edit.el dired.el faces.el files.el help-mode.el imenu.el
+ info.el isearch.el menu-bar.el mouse.el ange-ftp.el bindings.el
+ bookmark.el custom.el descr-text.el dired.texi etags.el finder.el
+ frame.el help-fns.el help.el and 10 other files
-Ed L. Cashin: changed gnus-sum.el imap.el
+Ed L. Cashin: changed gnus-sum.el
Ed Swarthout: changed hexl.el textmodes/table.el
-Eduard Wiebe: changed dired.el browse-url.el flymake.texi footnote.el
- javascript.el jit-lock.el korean.el locate.el mule-conf.el
- nxml-mode.texi objects.texi ps-print.el vc-rcs.el
-
Eduardo Muñoz: changed dired.el ls-lisp.el
+Eduard Wiebe: wrote flymake-tests.el
+and changed dired.el flymake.texi Makefile browse-url.el flymake.el
+ footnote.el javascript.el jit-lock.el korean.el locate.el mule-conf.el
+ nxml-mode.texi objects.texi ps-print.el sysdep.c test.c test.pl
+ vc-rcs.el
+
Edward M. Reingold: wrote cal-china.el cal-coptic.el cal-french.el
cal-islam.el cal-iso.el cal-julian.el cal-move.el cal-persia.el
calendar.el diary-lib.el holidays.el lunar.el
Edwin Steiner: changed gnus-nocem.el
-Ehud Karni: changed rmail.el aviion-intel.h complete.el configure.in
+Ehud Karni: changed rmail.el aviion-intel.h complete.el configure.ac
frame.el progmodes/compile.el rmailsum.el sort.el xdisp.c
Eirik Fuller: changed ralloc.c xterm.c
-Eli Barzilay: wrote calculator.el
+E. Jay Berkenbilt: changed b2m.c flyspell.el ispell.el unrmail.el
+ whitespace.el window.h
-Eli Tziperman: wrote rmail-spam-filter.el
+Elias Oltmanns: changed tls.el gnus-agent.el gnus-cite.el gnus-int.el
+ gnus-srvr.el gnus.el nnimap.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 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 702 other files
+Elias Pipping: changed doc-view.el XDelAssoc.c XMakeAssoc.c files.el
+ shr.el
-Elias Oltmanns: changed tls.el gnus-agent.el gnus-int.el gnus-srvr.el
- gnus.el
+Eli Barzilay: wrote calculator.el
-Elias Pipping: changed XDelAssoc.c XMakeAssoc.c shr.el
+Eli Tziperman: wrote rmail-spam-filter.el
+
+Eli Zaretskii: wrote [bidirectional display in xdisp.c]
+ [tty menus in term.c] bidi.c biditest.el rxvt.el tty-colors.el
+and changed xdisp.c msdos.c w32.c w32fns.c fileio.c files.el simple.el
+ w32proc.c display.texi dispnew.c dispextern.h config.bat emacs.c
+ sed1v2.inp src/makefile.w32-in term.c w32term.c msdos.h src/Makefile.in
+ keyboard.c process.c and 797 other files
-Emanuele Giaquinta: changed configure.in rxvt.el charset.c etags.c
+Emanuele Giaquinta: changed configure.ac rxvt.el charset.c etags.c
fontset.c frame.el gnus-faq.texi loadup.el lread.c sh-script.el
text.texi
animate.el apropos.el artist.el bookmark.el cal-menu.el calc-prog.el
calc-store.el calcalg3.el calendar.el calendar.texi checkdoc.el
code-pages.el codepage.el completion.el cus-edit.el diff.el
- and 53 other files
+ and 56 other files
Emmanuel Briot: wrote ada-prj.el xml.el
and co-wrote ada-mode.el ada-xref.el
and changed ada-stmt.el
-Era Eriksson: changed bibtex.el dired.el shell.el tramp.el tramp.texi
+Era Eriksson: changed bibtex.el dired.el json.el ses.el ses.texi shell.el
+ tramp.el tramp.texi
+
+Eric Abrahamsen: changed nnir.el eieio.el gnus-bcklg.el gnus-registry.el
+ gnus-sum.el gnus.texi nnimap.el nnmairix.el org.el org.texi ox-html.el
+ ox-latex.el registry.el
Eric Bélanger: changed image.c
-Eric Decker: changed hp800.h hpux10-20.h sysdep.c
+Eric Brown: changed eww.el
+
+Eric Decker: changed sysdep.c (and other files for HP-UX support)
Eric Ding: wrote goto-addr.el
and changed mh-utils.el mh-e.el mh-comp.el mh-mime.el
Eric Eide: changed gnus-xmas.el
-Eric Hanchrow: changed vc-git.el TUTORIAL.es abbrev.el autorevert.el
- cperl-mode.el delphi.el dired.el emacsclient.c env.el erc.el
- frames.texi ibuf-ext.el ispell.el ldap.el make-dist tramp.texi
- window.el
+Eric Hanchrow: changed erc.el vc-git.el TUTORIAL.es abbrev.el
+ autorevert.el cperl-mode.el dired.el emacsclient.c env.el frames.texi
+ ibuf-ext.el ispell.el ldap.el make-dist opascal.el progmodes/python.el
+ tramp.texi window.el
Éric Jacoboni: changed fr-refcard.tex
Eric Knauel: changed gnus.el spam-report.el spam.el
+Eric Marsden: changed gnus-cache.el url-util.el
+
Eric M. Ludlam: wrote analyze.el analyze/complete.el analyze/debug.el
args.el auto.el autoconf-edit.el base.el bovine.el bovine/debug.el
bovine/el.el bovine/make.el c.el cedet-cscope.el cedet-files.el
cedet-global.el cedet-idutils.el cedet-utests.el cedet/semantic.el
- cedet/srecode.el checkdoc.el cpp-root.el cscope.el data-debug.el
- db-debug.el db-el.el db-file.el db-find.el db-global.el db-mode.el
- db-ref.el db-typecache.el db.el decorate.el decorate/mode.el dep.el
- dframe.el dictionary.el doc.el document.el ede-grammar.el ede-tests.el
- ede.el ede/custom.el ede/dired.el ede/files.el ede/generic.el
- ede/linux.el ede/locate.el ede/make.el ede/shell.el ede/simple.el
- ede/speedbar.el ede/srecode.el ede/util.el edit.el eieio-base.el
- eieio-custom.el eieio-datadebug.el eieio-opt.el eieio-speedbar.el
+ cedet/srecode.el checkdoc.el config.el cpp-root.el cscope.el
+ data-debug.el db-debug.el db-el.el db-file.el db-find.el db-global.el
+ db-mode.el db-ref.el db-typecache.el db.el decorate.el decorate/mode.el
+ dep.el detect.el dframe.el dictionary.el doc.el document.el
+ ede-grammar.el ede-tests.el ede.el ede/custom.el ede/dired.el
+ ede/files.el ede/generic.el ede/linux.el ede/locate.el ede/make.el
+ ede/shell.el ede/simple.el ede/speedbar.el ede/srecode.el ede/util.el
+ edit.el eieio-base.el eieio-compat.el eieio-core.el eieio-custom.el
+ eieio-datadebug.el eieio-opt.el eieio-speedbar.el
+ eieio-test-methodinvoke.el eieio-test-persist.el eieio-tests.el
eieio.el emacs-lisp/chart.el emacs.el expandproto.el extract.el
ezimage.el fcn.el fields.el filter.el filters.el fw.el gcc.el getset.el
global.el html.el ia-sb.el ia.el idle.el idutils.el include.el
srt.el symref.el symref/grep.el system.el tag-file.el tag-ls.el
tag-write.el tag.el test.el
and co-wrote db-ebrowse.el srecode/cpp.el util-modes.el
-and changed info.el rmail.el speedbspec.el gud.el sb-dir-minus.xpm
+and changed c.srt ede.texi info.el rmail.el speedbspec.el cedet.el
+ ede-autoconf.srt ede-make.srt eieio.texi gud.el sb-dir-minus.xpm
sb-dir-plus.xpm sb-dir.xpm sb-mail.xpm sb-pg-minus.xpm sb-pg-plus.xpm
sb-pg.xpm sb-tag-gt.xpm sb-tag-minus.xpm sb-tag-plus.xpm
- sb-tag-type.xpm sb-tag-v.xpm sb-tag.xpm Makefile.in c-by.el cedet.el
- comint.el and 18 other files
+ sb-tag-type.xpm and 31 other files
-Eric Marsden: changed gnus-cache.el url-util.el
+Eric Schulte: wrote ob-C.el ob-asymptote.el ob-awk.el ob-calc.el
+ ob-comint.el ob-css.el ob-ditaa.el ob-dot.el ob-emacs-lisp.el
+ ob-eval.el ob-gnuplot.el ob-haskell.el ob-java.el ob-js.el ob-keys.el
+ ob-latex.el ob-makefile.el ob-ocaml.el ob-org.el ob-ruby.el ob-sass.el
+ ob-sh.el ob-shen.el ob-sql.el ob-sqlite.el ob-table.el ob-tangle.el
+ ob.el org-plot.el
+and co-wrote ob-R.el ob-clojure.el ob-core.el ob-exp.el ob-fortran.el
+ ob-lisp.el ob-lob.el ob-maxima.el ob-perl.el ob-picolisp.el
+ ob-python.el ob-ref.el ob-scheme.el org-bibtex.el
+and changed org.texi org.el org-exp-blocks.el ox.el ox-latex.el
+ org-src.el ob-plantuml.el ob-screen.el org-macs.el org-table.el
+ org-agenda.el org-mouse.el orgcard.tex ob-lilypond.el ob-mscgen.el
+ ob-octave.el org-clock.el org-compat.el org-footnote.el ox-ascii.el
+ ox-html.el and 12 other files
Eric S Fraga: wrote ob-ledger.el
and co-wrote ob-maxima.el
-and changed org-icalendar.el org-latex.el org.texi
+and changed ox-icalendar.el org.texi ox-latex.el
Eric S. Raymond: wrote AT386.el asm-mode.el cookie1.el finder.el gud.el
keyswap.el lisp-mnt.el loadhist.el
and co-wrote make-mode.el
-and changed vc.el vc-hooks.el vc-svn.el vc-cvs.el files.texi vc-bzr.el
- vc-dispatcher.el vc-git.el vc-hg.el vc-sccs.el vc-rcs.el vc-mcvs.el
- Makefile.in files.el comint.el simple.el vc-arch.el vc-mtn.el
- add-log.el cust-print.el dired.el and 249 other files
-
-Eric Schulte: wrote ob-C.el ob-asymptote.el ob-awk.el ob-calc.el
- ob-comint.el ob-css.el ob-ditaa.el ob-dot.el ob-emacs-lisp.el
- ob-eval.el ob-gnuplot.el ob-haskell.el ob-java.el ob-js.el ob-keys.el
- ob-latex.el ob-ocaml.el ob-org.el ob-ruby.el ob-sass.el ob-scheme.el
- ob-sh.el ob-shen.el ob-sql.el ob-sqlite.el ob-table.el ob-tangle.el
- org-exp-blocks.el org-plot.el
-and co-wrote ob-R.el ob-clojure.el ob-exp.el ob-fortran.el ob-lisp.el
- ob-lob.el ob-maxima.el ob-perl.el ob-picolisp.el ob-python.el ob-ref.el
- ob.el org-bibtex.el
-and changed org.texi org.el org-exp.el org-latex.el ob-plantuml.el
- org-src.el org-table.el org-agenda.el org-macs.el orgcard.tex
- ob-lilypond.el ob-mscgen.el ob-octave.el ob-screen.el org-ascii.el
- org-footnote.el org-html.el org-mouse.el gnus-art.el ob-ledger.el
- ob-matlab.el and 5 other files
+and changed vc.el vc-hooks.el vc-svn.el vc-cvs.el vc-git.el vc-rcs.el
+ vc-sccs.el vc-hg.el vc-bzr.el vc-dispatcher.el files.texi vc-mcvs.el
+ vc-mtn.el files.el comint.el emacsbug.el simple.el vc-arch.el vc-src.el
+ Makefile.in add-log.el and 271 other files
Eric Youngdale: changed etags-vmslib.c
Eric Yu: changed speedbar.texi
+Erik Charlebois: changed syntax.el w32fns.c w32term.c w32term.h
+
+Erik Hetzner: changed org.el
+
Erik Naggum: wrote disp-table.el mailheader.el parse-time.el
and changed simple.el emacs.c files.el lread.c rmail.el alloc.c editfns.c
- keyboard.c apropos.el configure.in dispnew.c filelock.c fns.c keymap.c
+ keyboard.c apropos.el configure.ac dispnew.c filelock.c fns.c keymap.c
lisp.h print.c process.c add-log.el buffer.c casetab.c cl-macs.el
and 114 other files
Erik Toubro Nielsen: changed gnus-sum.el gnus-topic.el
+E Sabof: changed hi-lock.el image-dired.el
+
Espen Skoglund: wrote pascal.el
Espen Wiborg: changed utf-7.el
Ethan Bradford: changed ispell.el ange-ftp.el gnus.el gnuspost.el lpr.el
mailalias.el vt-control.el
-Ethan Ligon: changed org-docbook.el org-html.el
+Ethan Ligon: changed org-docbook.el ox-html.el
Eugene Exarevsky: changed sql.el
Evgeny Roubinchtein: changed mail-source.el pc-select.el
-Exal de Jesus Garcia Carrillo: changed erc.texi erc-sound.el
+Exal de Jesus Garcia Carrillo: changed erc-sound.el erc.texi
-F. Thomas May: wrote blackbox.el
+Eyal Lotem: changed ido.el
-Fabian Ezequiel Gallina: changed progmodes/python.el
+Fabián Ezequiel Gallina: wrote progmodes/python.el subr-x-tests.el
+and changed python-tests.el subr-x.el imenu.el
Fabrice Bauzac: changed dired-aux.el
-Fabrice Popineau: changed config.nt etags.c fileio.c gnus-cache.el
- inttypes.h lisp.h ms-w32.h nmake.defs regex.c stdint.h w32.c w32heap.c
+Fabrice Niessen: wrote leuven-theme.el
+and changed org-agenda.el
+
+Fabrice Popineau: changed w32.c ms-w32.h w32fns.c w32heap.c configure.ac
+ lisp.h unexw32.c w32term.c buffer.c emacs.c image.c nmake.defs
+ w32heap.h w32proc.c INSTALL addsection.c alloc.c config.nt dispextern.h
+ emacs-x64.manifest emacs-x86.manifest and 23 other files
Fan Kai: changed esh-arg.el
Faried Nawaz: changed message.el
+Felix H. Dahlke: changed js.el
+
Felix Lee: changed flyspell.el outline.el cl.texi data.c gud.el nntp.el
process.c progmodes/compile.el vc.el xdisp.c
Felix S. T. Wu: co-wrote vi.el (public domain)
-Feng Li: changed calc-ext.el
+Feng Li: changed calc-ext.el pascal.el which-func.el
+
+Feng Shu: changed org.el org.texi ox.el ox-html.el ox-latex.el ox-odt.el
Ferenc Wagner: changed nnweb.el
Filipe Cabecinhas: changed nsterm.m
+Filipp Gunbin: changed autorevert.el cc-menus.el dired-aux.el info.el
+ info.texi
+
Flemming Hoejstrup Hansen: changed forms.el
+Florian Adamsky: changed recentf.el
+
+Florian Beck: changed org.el
+
Florian Ragwitz: changed gnus-html.el sieve-manage.el
Florian Weimer: changed message.el gnus.el coding.c gnus-sum.el gnus.texi
mm-decode.el mm-util.el
-Fran Litterio: changed erc-backend.el erc.el
-
-Francesc Rocher: changed MORE.STUFF startup.el cus-start.el gnus.el
- gnus.png gnus.svg macterm.c splash.png splash.svg splash8.xpm w32term.c
- xdisp.c xterm.c
+Francesco Pizzolante: changed org-clock.el org-macs.el org.el ox-html.el
Francesco Potortì: wrote cmacexp.el
-and changed etags.c man.el delta.h etags.1 undigest.el Makefile.in
- comint.el configure.in maintaining.texi uniquify.el latin-post.el
- rmail.el etags.el latin-alt.el sgml-mode.el data.c european.el
- filelock.c files.el generic-x.el gud.el and 45 other files
+and changed etags.c man.el delta.h etags.1 undigest.el comint.el
+ configure.ac maintaining.texi uniquify.el latin-post.el rmail.el
+ etags.el latin-alt.el lib-src/Makefile.in sgml-mode.el Makefile.in
+ data.c european.el filelock.c files.el generic-x.el and 44 other files
+
+Francesc Rocher: changed MORE.STUFF splash.png splash.svg startup.el
+ README cus-start.el gnus.el gnus.png gnus.svg macterm.c splash.pbm
+ splash.xpm splash8.xpm w32term.c xdisp.c xterm.c
Francis Devereux: changed nsfont.m
and changed dired.el comint.el cus-edit.el files.el ps-print.el
Francis Litterio: changed erc.el erc-list.el erc-dcc.el erc-notify.el
- erc-button.el erc-goodies.el erc-nets.el erc-ring.el erc-pcomplete.el
- message.el erc-backend.el erc-ibuffer.el erc-match.el erc-nickserv.el
- erc-page.el erc-speedbar.el gnus-util.el keymaps.texi os.texi
- saveplace.el w32term.c and 3 other files
+ erc-button.el erc-goodies.el erc-nets.el erc-ring.el Makefile
+ erc-pcomplete.el message.el erc-backend.el erc-ibuffer.el erc-match.el
+ erc-nickserv.el erc-page.el erc-speedbar.el gnus-util.el keymaps.texi
+ os.texi saveplace.el and 4 other files
+
+François Allisson: changed org.texi
+
+François-David Collin: changed message.el mm-decode.el
Francois Felix Ingrand: changed gnus-salt.el
Francois Fleuret: changed tex-mode.el
+François Pinard: co-wrote po.el
+and changed nndoc.el allout.el bytecomp.el gnus-sum.el gnus-util.el
+ gnus-uu.el make-mode.el nnmail.el org.el rmailsum.el timezone.el
+
Frank Bennett: changed nnmail.el
Frank Bresz: wrote diff.el
Frank Weinberg: changed gnus-art.el
-François Pinard: co-wrote po.el
-and changed nndoc.el allout.el bytecomp.el gnus-sum.el gnus-util.el
- gnus-uu.el make-mode.el nnmail.el org.el rmailsum.el timezone.el
-
-François-David Collin: changed message.el mm-decode.el
-
-Fred Fish: changed linux.h unexcoff.c
+Fran Litterio: changed erc-backend.el erc.el
-Fred Oberhauser: changed nnmail.el
+Frédéric Bothamy: changed TUTORIAL.fr
Frederic Han: changed iso-cvt.el
Frederic Lepied: wrote expand.el
and changed gnus.el
+Frédéric Perrin: changed vc-dispatcher.el
+
Frederic Pierresteguy: wrote widget.c
and changed xmenu.c xterm.c xfns.c dpx2.h lwlib.c rmailsum.el rmail.el
- xlwmenu.c xterm.h lwlib-Xaw.c lwlib-Xlw.c Makefile.in configure.in
- lwlib-Xaw.h lwlib-int.h xdisp.c compile.el editfns.c fns.c frame.h
- hilit19.el and 9 other files
+ xlwmenu.c xterm.h lwlib-Xaw.c lwlib-Xlw.c configure.ac lwlib-Xaw.h
+ lwlib-int.h xdisp.c compile.el editfns.c fns.c frame.h hilit19.el
+ keyboard.c and 10 other files
Frederik Fouvry: changed sendmail.el TUTORIAL.nl emacs.bash faces.el
filecache.el mailalias.el rmail.el thumbs.el
+Fred Fish: changed linux.h unexcoff.c
+
+Fred Oberhauser: changed nnmail.el
+
Fredrik Axelsson: changed cus-start.el window.c
Friedrich Delgado Friedrichs: changed org.el
Fritz Knabe: changed mh-mime.el
-Frédéric Bothamy: changed TUTORIAL.fr
+F. Thomas May: wrote blackbox.el
-Frédéric Perrin: changed vc-dispatcher.el
+Fujii Hironori: changed w32fns.c
-G Dinesh Dutt: changed etags.el
+Gábor Vida: changed gnus-demon.el auth-source.el ido.el
Gareth Jones: changed fns.c gnus-score.el
+Gareth Rees: changed NEWS.24
+
Garrett Wollman: changed sendmail.el
+Gary Delp: wrote mailpost.el (public domain)
+
Gary D. Foster: wrote crisp.el scroll-all.el
and changed gnus-group.el gnus-topic.el
-Gary Delp: wrote mailpost.el (public domain)
-
Gary Howell: changed server.el
Gary Oberbrunner: changed gud.el
Gary Wong: changed termcap.c tparam.c
-Gaute B Strokkenes: changed imap.el gnus-fun.el mail-source.el process.c
+Gaute B Strokkenes: changed gnus-fun.el mail-source.el process.c
+
+G Dinesh Dutt: changed etags.el
Geert Kloosterman: changed which-func.el
Geoff Greene: changed message.el
+Geoff Kuenning: changed gnus-art.el gnus.texi
+
Geoff Voelker: wrote ms-w32.h w32-fns.el w32.c w32.h w32heap.c w32heap.h
w32inevt.c w32proc.c w32term.c
and changed makefile.nt w32fns.c fileio.c makefile.def callproc.c
- s/ms-w32.h unexw32.c w32term.h dos-w32.el emacs.bat loadup.el
- w32-win.el emacs.c keyboard.c process.c w32console.c addpm.c cmdproxy.c
- comint.el files.el ntterm.c and 104 other files
+ s/ms-w32.h emacs.bat.in unexw32.c w32term.h dos-w32.el loadup.el
+ w32-win.el emacs.c keyboard.c ntterm.c process.c w32console.c addpm.c
+ cmdproxy.c comint.el files.el and 101 other files
Georg C. F. Greve: changed pgg-gpg.el
-George V. Reilly: changed emacs.ico makefile.nt
+George Kettleborough: changed org-clock.el org-timer.el
+
+George McNinch: changed nnir.el
Georges Brun-Cottan: wrote easy-mmode.el
+George V. Reilly: changed emacs.ico makefile.nt
+
Gerd Möllmann: wrote authors.el ebrowse.el jit-lock.el rx.el tooltip.el
and changed xdisp.c xterm.c dispnew.c dispextern.h xfns.c xfaces.c
- window.c keyboard.c lisp.h Makefile.in faces.el alloc.c buffer.c
- startup.el xterm.h fns.c simple.el term.c frame.c xmenu.c emacs.c
- and 617 other files
+ window.c keyboard.c lisp.h faces.el alloc.c buffer.c startup.el xterm.h
+ fns.c simple.el term.c configure.ac frame.c xmenu.c emacs.c
+ and 600 other files
Gergely Nagy: changed erc.el
+Gergely Risko: changed coding.c
+
Germano Caronni: changed ralloc.c
Gernot Heiser: changed refer.el
-Giorgos Keramidas: changed configure.in erc-backend.el erc.el alloc.c
+Giorgos Keramidas: changed configure.ac erc-backend.el erc.el alloc.c
amdx86-64.h apropos.el display.texi erc-services.el filelock.c fringe.c
fringe.el lisp.h rcirc.el windows.texi xmenu.c
+Giovanni Ridolfi: changed org.texi
+
Giuliano Procida: changed perl-mode.el
-Giuseppe Scrivano: changed browse-url.el buffer.c configure.in sysdep.c
+Giuseppe Scrivano: changed browse-url.el buffer.c configure.ac sysdep.c
xsmfns.c
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
- 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
+and changed configure.ac Makefile.in src/Makefile.in calendar.el
+ diary-lib.el files.el lisp/Makefile.in rmail.el progmodes/f90.el
+ make-dist simple.el misc/Makefile.in bytecomp.el emacs.texi
+ lib-src/Makefile.in ack.texi authors.el cal-menu.el startup.el
+ display.texi admin.el and 1534 other files
Glynn Clements: wrote gamegrid.el snake.el tetris.el
+Göran Uddeborg: changed isc4-1.h
+
Gordon Matzigkeit: changed gnus-uu.el
Greg Hill: changed bytecomp.el
-Greg Hudson: changed configure.in indent.c
+Greg Hudson: changed configure.ac indent.c
Greg Klanderman: changed messagexmas.el
Greg McGary: co-wrote po.el
and changed tar-mode.el
-Greg Stark: changed gnus-ems.el timezone.el
-
-Gregor Schmid: changed intervals.c intervals.h tcl-mode.el textprop.c
- dispnew.c indent.c xdisp.c
+Grégoire Jadi: changed org.texi rcirc.el latin-post.el ob-core.el
+ org-id.el org.el reporter.el sendmail.el
Gregorio Gervasio, Jr.: changed gnus-sum.el
-Gregory Chernov: changed nnslashdot.el
+Gregor Kappler: changed ox.el
+
+Gregor Schmid: changed intervals.c intervals.h tcl-mode.el textprop.c
+ dispnew.c indent.c xdisp.c
Gregory Neil Shapiro: changed mailabbrev.el
+Gregor Zattler: changed emacs-lisp-intro.texi
+
+Greg Stark: changed gnus-ems.el timezone.el
+
Guanpeng Xu: changed add-log.el TUTORIAL.cn display.texi mouse.el
pcomplete.el search.c subr.el type-break.el
Gustav Hållberg: changed descr-text.el progmodes/compile.el rect.el vc.el
+Gustav Wikström: changed org-agenda.el org.texi
+
Guy Geens: changed gnus-score.el
Gwern Branwen: changed browse-url.el
-Göran Uddeborg: changed isc4-1.h
+Håkan Granath: changed dired.el
+
+Håkon Malmedal: changed calendar.el holidays.el
Hallvard B. Furuseth: co-wrote byte-opt.el byte-run.el bytecomp.el
and changed gnus-util.el editfns.c gnus-cache.el gnus-sum.el lread.c
Hamano Kiyoto: changed xml.c
-Han Boetes: changed netbsd.h
+Hanataka, Shinya: changed coding.c
-Han-Wen Nienhuys: changed emacsclient.c server.el
+Han Boetes: changed netbsd.h
Hans Chalupsky: wrote advice.el trace.el
and changed bytecomp.el
+Hans de Graaff: changed mml.el
+
Hans Henrik Eriksen: wrote simula.el
-Hans de Graaff: changed mml.el
+Hans-Peter Deifel: changed ob.el
+
+Hans Wennborg: changed emacs.c
+
+Han-Wen Nienhuys: changed emacsclient.c server.el
Harald Maier: changed w32heap.c
Harald Meland: changed gnus-art.el gnus-salt.el gnus-score.el
gnus-util.el gnus-win.el mail-source.el
-Harri Kiiskinen: changed org-publish.el
+Harri Kiiskinen: changed org-protocol.el ox-publish.el
+
+H. Dieter Wilhelm: changed calc-help.el maintaining.texi
Heiko Muenkel: changed b2m.c
-Helmut Eller: changed cl-macs.el emacs-lisp/debug.el process.c
+Helmut Eller: changed emacs-lisp/debug.el cl-indent.el cl-macs.el
+ elisp-mode.el etags.el eval.c lisp-mode.el process-tests.el process.c
+ xref.el
Helmut Waitzmann: changed gnus-sum.el gnus.texi
+Henning Weiss: changed org-mobile.el
+
Henrik Enberg: changed rmailout.el gnus-art.el gnus-msg.el lread.c
mail/rmailmm.el rmail.el rmailedit.el rmailkwd.el rmailmsc.el
rmailsort.el rmailsum.el xfaces.c
Hideki Iwamoto: changed etags.c
-Hiroshi Fujishima: changed faq.texi gnus-score.el mail-source.el
+Hiroshi Fujishima: changed efaq.texi gnus-score.el mail-source.el
spam-stat.el
Hiroshi Nakano: changed ralloc.c unexelf.c
Hynek Schlawack: changed gnus-art.el gnus-sum.el
-Håkan Granath: changed dired.el
+Ian D: changed doc-view.el image-mode.el
-Håkon Malmedal: changed calendar.el holidays.el
+Ian Eure: changed sql.el url-util.el
-Ian Eure: changed sql.el
+Ian Kelling: changed ob-core.el
Ian Lance Taylor: changed sco4.h
Igor Kuzmin: wrote cconv.el
+Ikumi Keita: changed characters.el minibuf.c
+
Ilja Weis: co-wrote gnus-topic.el
Ilya N. Golubev: changed mm-util.el shell.el
Ilya Zakharevich: wrote tmm.el
and co-wrote cperl-mode.el
-and changed syntax.c syntax.h textprop.c dired.c font-lock.el interval.c
- intervals.c intervals.h regex.c regex.h search.c
+and changed syntax.c intervals.c syntax.h textprop.c dired.c font-lock.el
+ intervals.h regex.c regex.h search.c
+
+Ilya Zonov: changed org-mouse.el
Indiana University Foundation: changed buffer.c buffer.h indent.c
region-cache.c region-cache.h search.c xdisp.c
Inge Wallin: co-wrote avl-tree.el ewoc.el
+Ingo Lohmar: changed help-fns.el ls-lisp.el org-agenda.el org.el
+
Inoue Seiichiro: changed xterm.c xfns.c xterm.h
International Business Machines: changed emacs.c fileio.c process.c
sysdep.c unexcoff.c
+Ippei Furuhashi: changed org.texi org-colview.el org-table.el org.el
+
Irie Shinsuke: changed subr.el
Irie Tetsuya: changed gnus.texi message.texi
Itai Zukerman: changed mm-decode.el
+Ivan Andrus: changed ffap.el find-file.el ibuf-ext.el ibuffer.el
+ progmodes/python.el
+
Ivan Boldyrev: changed mml1991.el
Ivan Kanis: wrote vc-hg.el
-and changed appt.el term.el time.el
+and changed eww.el shr.el appt.el dired.el saveplace.el term.el time.el
+
+Ivan Shmakov: changed eww.el shr.el desktop.el eww.texi files.el
+ cus-dep.el diff-mode.el enriched.el erc-track.el facemenu.el faces.el
+ files.texi misearch.el nndoc.el tar-mode.el tcl.el tex-mode.el
+ url-cookie.el
-Ivan Shmakov: changed tcl.el
+Ivan Vilata i Balaguer: changed org-clock.el org.texi
Ivan Zakharyaschev: changed codepage.el lread.c
Iwamuro Motonori: changed gnus-kill.el
-J.D. Smith: co-wrote idlw-help.el idlw-shell.el idlwave.el
-and changed idlw-rinfo.el idlw-toolbar.el comint.el idlwave.texi vc.el
- bibtex.el files.texi hideshow.el idlw-complete-structtag.el misc.texi
- mouse.el
-
Jaap-Henk Hoepman: changed mm-decode.el
+Jacek Chrząszcz: changed ispell.el
+
+Jack Duthen: changed which-func.el
+
Jack Repenning: changed unexelfsgi.c
Jack Twilley: changed message.el
Jacques Duthen: co-wrote ps-print.el ps-samp.el
-Jae-Hyeon Park: changed fontset.el
+Jae-hyeon Park: changed fontset.el
Jaeyoun Chung: changed hangul3.el hanja3.el gnus-mule.el hangul.el
-Jambunathan K: wrote org-lparse.el org-odt.el
-and changed org.el org-exp.el org.texi OrgOdtContentTemplate.xml
- org-footnote.el org-inlinetask.el OrgOdtStyles.xml htmlfontify.el
- org-html.el package-x.el quail/indian.el tar-mode.el
+Jambunathan K: wrote ox-odt.el
+and co-wrote ox-html.el
+and changed org-lparse.el org.el org.texi ox.el icomplete.el
+ OrgOdtContentTemplate.xml OrgOdtStyles.xml hi-lock.el replace.el
+ minibuffer.el org-footnote.el org-inlinetask.el register.el doc-view.el
+ etags.el htmlfontify.el ido.el indian.el iswitchb.el org-bbdb.el
+ org-compat.el and 6 other files
James Clark: wrote nxml-enc.el nxml-glyph.el nxml-maint.el nxml-mode.el
nxml-ns.el nxml-outln.el nxml-parse.el nxml-rap.el nxml-uchnm.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-colview-xemacs.el org-plot.el org-agenda.el
- org-compat.el org-habit.el org.texi
+ org-remember.el org-plot.el org-agenda.el org-compat.el org-habit.el
+ org.texi
James Troup: changed gnus-sum.el
-James Van Artsdalen: changed unexcoff.c usg5-4.h
+James Van Artsdalen: changed unexcoff.c
James Wright: changed em-unix.el
and co-wrote byte-opt.el byte-run.el bytecomp.el disass.el font-lock.el
and changed bytecode.c mail-extr.el subr.el
-Jan Böcker: wrote org-docview.el
-and changed org.el
+Jan Beich: changed configure.ac
-Jan Böker: changed org.el
+Jan Böcker: wrote org-docview.el
+and changed org.el org.texi
Jan Djärv: wrote dnd.el dynamic-setting.el x-dnd.el
-and changed gtkutil.c xterm.c xfns.c configure.in xmenu.c xterm.h
- gtkutil.h nsterm.m x-win.el keyboard.c Makefile.in frames.texi
- xsettings.c emacs.c frame.c nsfns.m xselect.c process.c xlwmenu.c
- config.in cus-start.el and 303 other files
+and changed gtkutil.c xterm.c nsterm.m xfns.c configure.ac nsfns.m
+ xmenu.c xterm.h nsterm.h nsmenu.m gtkutil.h keyboard.c x-win.el emacs.c
+ frame.c process.c src/Makefile.in xsettings.c nsfont.m cus-start.el
+ frames.texi and 301 other files
+
+Jan-Hein Buhrman: changed ange-ftp.el env.el
Jan Moringen: co-wrote srecode/cpp.el tango-dark-theme.el tango-theme.el
-and changed dbus.el dbus.texi dbusbind.c eieio.el log-edit.el zeroconf.el
+and changed dbus.el dbus.texi dbusbind.c eieio.el idle.el insert.el
+ log-edit.el srecode/find.el wisent/python.el zeroconf.el
-Jan Nieuwenhuizen: changed info.el TUTORIAL.nl add-log.el emacs.c
- emacsclient.c gnus-start.el gud.el nnmh.el server.el startup.el
+Jan Nieuwenhuizen: changed gud.el info.el TUTORIAL.nl add-log.el
+ compilation.txt compile-tests.el emacs.c emacsclient.c gnus-start.el
+ nnmh.el progmodes/compile.el server.el startup.el
Jan Rychter: changed gnus-msg.el
Jan Schormann: wrote solitaire.el
-Jan Seeger: changed org-publish.el parse-time.el
+Jan Seeger: changed ox-publish.el parse-time.el
-Jan Vroonhof: changed gnus-cite.el gnus-msg.el nntp.el
+Jan Tatarik: wrote gnus-icalendar.el
+and changed gnus-score.el gnus-logic.el
-Jan-Hein Buhrman: changed ange-ftp.el env.el
+Jan Vroonhof: changed gnus-cite.el gnus-msg.el nntp.el
Jared Finder: changed progmodes/compile.el
+Jarek Czekalski: changed keyboard.c callproc.c mini.texi minibuf.c
+ misc.texi server.el shell.el w32fns.c xgselect.c
+
Jari Aalto: changed add-log.el filecache.el progmodes/grep.el comint.el
gnus-art.el gnus-sum.el gnus.texi ispell.el lisp-mnt.el man.el
- nnmail.el apropos.el autorevert.el checkdoc.el cperl-mode.el desktop.el
- em-ls.el emacs-lisp/debug.el emacsclient.1 executable.el files.el
- and 20 other files
+ nnmail.el apropos.el autorevert.el checkdoc.el cperl-mode.el
+ css-mode.el desktop.el em-ls.el emacs-lisp/debug.el emacsclient.1
+ executable.el and 23 other files
+
+Jarmo Hurri: changed org-gnus.el org-table.el org.texi
+
+Jarosław Rzeszótko: changed url-http.el
Jason Baker: changed gnus-art.el
-Jason Dunsmore: changed org-html.el org.el
+Jason Dunsmore: changed org.el ox-html.el
+
+Jason L. Wright: changed smtpmail.el
-Jason Merrill: changed gnus-sum.el add-log.el gnus-salt.el imap.el
- nnfolder.el
+Jason Merrill: changed gnus-sum.el add-log.el gnus-salt.el nnfolder.el
Jason Riedy: changed org-table.el org.texi
Jason Rumney: wrote w32-vars.el
-and changed w32fns.c w32term.c w32font.c makefile.w32-in w32menu.c
- w32-win.el w32term.h w32.c w32uniscribe.c w32-fns.el makefile.nt
- w32console.c w32bdf.c configure.bat keyboard.c w32proc.c w32select.c
- font.c image.c w32font.h w32gui.h and 160 other files
+and changed w32fns.c w32term.c w32font.c w32menu.c w32-win.el w32term.h
+ w32.c w32uniscribe.c src/makefile.w32-in w32-fns.el makefile.nt
+ w32console.c w32bdf.c lib-src/makefile.w32-in configure.bat keyboard.c
+ w32proc.c w32select.c font.c image.c w32font.h and 165 other files
-Jay Belanger: changed calc.texi calc.el calc-ext.el calc-aent.el
- calc-units.el calc-embed.el calc-help.el calc-lang.el calc-prog.el
- calc-math.el calccomp.el calc-arith.el calc-graph.el calc-forms.el
- calc-misc.el calc-store.el calc-yank.el calcalg2.el calc-bin.el
- calc-alg.el calc-vec.el and 40 other files
+Jason S. Cornez: changed keyboard.c
+
+Jay Belanger: changed calc.texi calc.el calc-ext.el calc-units.el
+ calc-aent.el calc-embed.el calc-help.el calc-lang.el calc-prog.el
+ calc-forms.el calccomp.el calc-math.el calc-arith.el calc-graph.el
+ calc-misc.el calcalg2.el calc-alg.el calc-store.el calc-yank.el
+ calc-bin.el calc-mode.el and 39 other files
Jay K. Adams: wrote jka-cmpr-hook.el jka-compr.el
+Jay McCarthy: changed org-colview.el
+
Jay Sachs: changed gnus-score.el gnus-win.el
+J.D. Smith: co-wrote idlw-help.el idlw-shell.el idlwave.el
+and changed idlw-rinfo.el idlw-toolbar.el comint.el idlwave.texi vc.el
+ bibtex.el files.texi hideshow.el idlw-complete-structtag.el misc.texi
+ mouse.el
+
+Jean Haidouk: changed latin-alt.el latin-post.el latin-pre.el
+
+Jean-Philippe Gravel: changed gdb-mi.el
+
Jean-Philippe Theberge: wrote thumbs.el
+Jed Brown: changed progmodes/compile.el
+
Jeff Dairiki: changed whitespace.el
Jeff Dwork: changed ehelp.el facemenu.el
Jeff Norden: wrote kermit.el
Jeff Peck: wrote sun.el
+and changed emacstool.1 emacstool.c
Jeffrey C Honig: wrote mh-print.el
and changed mh-e.el mh-comp.el mh-utils.el mh-mime.el mh-customize.el
- mh-funcs.el mh-alias.el mh-seq.el bsdos4.h mh-folder.el mh-junk.el
- mh-show.el
+ mh-folder.el mh-funcs.el mh-alias.el mh-seq.el mh-show.el Makefile
+ bsdos4.h mh-junk.el mh-letter.el
Jens Krinke: changed smime.el
Jens-Ulrik Holger Petersen: changed cus-edit.el ffap.el find-func.el
gnus.el
-Jeramey Crawford: changed amdx86-64.h configure.in
+Jeramey Crawford: changed amdx86-64.h configure.ac
+
+Jérémie Courrèges-Anglas: changed org.texi ox-latex.el
Jeremy Bertram Maitin-Shepard: changed erc.el erc-backend.el
erc-button.el erc-track.el mml.el
+Jérémy Compostella: changed tramp-sh.el battery.el keyboard.c windmove.el
+ window.el xdisp.c
+
+Jeremy Moore: changed hideif.el
+
Jeremy Whitlock: changed progmodes/python.el
+Jérôme Marant: changed make-dist Makefile.in bindings.el configure.ac
+ emacsclient.c leim/Makefile.in misc.texi
+
Jerry Frain: changed systime.h usg5-4.h
Jerry James: changed format.el dns.el gnus-spec.el gnus-util.el
gnus.el gnus-util.el rfc2047.el mm-bodies.el mm-util.el mml.el
mm-decode.el nnrss.el gnus-srvr.el gnus-topic.el nnmail.el
gnus-start.el gnus-uu.el spam-stat.el gnus-score.el gnus.texi
- and 201 other files
+ and 197 other files
Jhair Tocancipa Triana: changed gnus-audio.el
Jim Blandy: wrote tvi970.el
and co-wrote wyse50.el
-and changed keyboard.c xterm.c xfns.c Makefile.in window.c process.c
- ymakefile dispnew.c xdisp.c sysdep.c configure.in lisp.h keymap.c
+and changed keyboard.c xterm.c xfns.c window.c process.c ymakefile
+ dispnew.c xdisp.c sysdep.c configure.ac lisp.h Makefile.in keymap.c
configure make-dist buffer.c frame.c screen.c simple.el alloc.c emacs.c
- and 388 other files
+ and 402 other files
+
+Jim Diamond: changed server.el
-Jim Kingdon: changed emacsclient.c emacs.tex functions.texinfo hp300bsd.h
+Jim Kingdon: changed emacs.texi emacsclient.c functions.texi hp300bsd.h
rmail.el
-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 Meyering: changed lread.c make-docfile.c w32.c w32font.c copyright.el
+ ebrowse.c emacs.c nsfont.m pop.c term.c xfaces.c xselect.c xterm.c
+ alloc.c artist.el autoinsert.el buffer.h callproc.c character.h
+ charset.c configure and 56 other files
+
+Jim Paris: changed process.c
Jim Radford: changed gnus-start.el
Jim Thompson: co-wrote ps-print.el ps-samp.el
-Jim Wilson: changed Makefile.in alloca.c
+Jim Wilson: changed alloca.c oldXMenu/Makefile.in
Jindrich Makovicka: changed eval.c fns.c
Joachim Reiter: changed org-footnote.el
+Joakim Hårsman: changed w32fns.c
+
Joakim Hove: wrote html2text.el
Joakim Verona: wrote db-javascript.el
and co-wrote db-ebrowse.el
-and changed Makefile.in configure.in image-mode.el image.c image.el
+and changed Makefile.in configure.ac image-mode.el image.c image.el
nnrss.el progmodes/compile.el thingatpt.el window.c window.h
Joanna Pluta: changed TUTORIAL.pl
+João Cachopo: changed spam.el
+
+João Távora: wrote elec-pair.el electric-tests.el
+and changed shr.el tex-mode.el electric.el emacs.texi lisp-mode.el
+ progmodes/python.el python-tests.el simple.el tls.el vc.el
+
Jochen Hein: changed gnus-art.el
Jochen Küpper: changed gnus.texi calc-units.el
-Joe Buehler: changed Makefile.in configure.in cygwin.h browse-url.el
- comint.el configure dired-aux.el dired.el dirtrack.el dos-w32.el
- fast-lock.el filecache.el fileio.c files.el gmalloc.c gnus-util.el
- hippie-exp.el keyboard.c lastfile.c loadup.el mem-limits.h
- and 11 other files
+Joe Buehler: changed configure.ac cygwin.h src/Makefile.in Makefile.in
+ browse-url.el comint.el configure dired-aux.el dired.el dirtrack.el
+ dos-w32.el fast-lock.el filecache.el fileio.c files.el gmalloc.c
+ gnus-util.el hippie-exp.el keyboard.c lastfile.c lib-src/Makefile.in
+ and 13 other files
Joe Casadonte: changed gnus-srvr.el
Joe Edmonds: changed lisp-mode.el
+Joel Bion: changed pcmpl-gnu.el
+
+Joel Boehland: co-wrote ob-clojure.el ob-lisp.el
+
+Joel N. Weber II: changed comint.el make-dist
+
+Joel Ray Holveck: changed gnus-sum.el info.el
+
Joe Matarazzo: changed ebrowse.c
Joe Ramey: changed filelock.c rmailsum.el
Joe Reiss: changed gnus-art.el
+Joev Dubach: changed nntp.el
+
+Joe Vornehm Jr.: changed ido.el
+
Joe Wells: wrote mail-extr.el resume.el
and co-wrote apropos.el
and changed arc-mode.el tex-mode.el
-Joel Boehland: co-wrote ob-clojure.el ob-lisp.el
-
-Joel N. Weber II: changed comint.el make-dist
-
-Joel Ray Holveck: changed gnus-sum.el info.el
-
-Joev Dubach: changed nntp.el
-
Johan Bockgård: changed erc.el cl-macs.el erc-backend.el erc-button.el
- erc-match.el xdisp.c browse-url.el bytecomp.el custom.el display.texi
- erc-compat.el erc-nickserv.el erc-ring.el erc-speak.el erc-track.el
- help-fns.el icomplete.el mouse-sel.el simple.el subr.el xterm.el
- and 48 other files
+ erc-match.el icomplete.el xdisp.c browse-url.el bytecomp.el custom.el
+ display.texi erc-compat.el erc-nickserv.el erc-ring.el erc-speak.el
+ erc-track.el help-fns.el mouse-sel.el simple.el subr.el xterm.el
+ and 54 other files
+
+Johan Claesson: changed filecache.el
Johan Euphrosine: changed ibuf-ext.el
+Johannes Weiner: changed browse-url.el keyboard.c configure.ac
+ lisp-mode.el lisp.h pp.el sound.c w32term.c xfaces.c xterm.c
+
Johan Vromans: wrote forms-d2.el forms.el iso-acc.el
and changed complete.el
-Johannes Weiner: changed browse-url.el keyboard.c configure.in
- lisp-mode.el lisp.h pp.el sound.c w32term.c xfaces.c xterm.c
+John Anthony: changed inf-lisp.el ruby-mode.el text-mode.el
John Basrai: changed man.el
John F. Carr: changed dired.c
-John F. Whitehead: changed mule-cmds.el mule-diag.el
-
John Fremlin: changed gnus-msg.el message.el
-John Grabowski: changed xfaces.c xfns.c
+John F. Whitehead: changed mule-cmds.el mule-diag.el
-John H. Palmieri: changed gnus-fun.el
+John Grabowski: changed xfaces.c xfns.c
John Heidemann: wrote mouse-copy.el mouse-drag.el
+John H. Palmieri: changed gnus-fun.el
+
John Hughes: changed term.c
John J Foerch: changed display.texi erc-stamp.el org.el
progmodes/compile.el
+John K. Luebs: changed org.el
+
+John Marino: changed configure.ac
+
+John Mastro: changed auth-source.el
+
John Mongan: changed progmodes/f90.el
John Paul Wallington: changed ibuffer.el ibuf-ext.el subr.el help-fns.el
John Tobey: changed gud.el
-John W. Eaton: co-wrote octave-mod.el
-and changed octave-inf.el
+John W. Eaton: co-wrote octave.el
-John Wiegley: wrote align.el cal-bahai.el em-alias.el em-banner.el
- em-basic.el em-cmpl.el em-dirs.el em-glob.el em-hist.el em-ls.el
- em-pred.el em-prompt.el em-rebind.el em-script.el em-smart.el
+John Wiegley: wrote align.el automated/eshell.el cal-bahai.el em-alias.el
+ em-banner.el em-basic.el em-cmpl.el em-dirs.el em-glob.el em-hist.el
+ em-ls.el em-pred.el em-prompt.el em-rebind.el em-script.el em-smart.el
em-term.el em-unix.el em-xtra.el erc-identd.el esh-arg.el esh-cmd.el
esh-ext.el esh-io.el esh-mode.el esh-module.el esh-opt.el esh-proc.el
esh-util.el esh-var.el eshell/eshell.el eudcb-mab.el isearchb.el
org-attach.el org-crypt.el org-habit.el pcmpl-cvs.el pcomplete.el
- remember.el test/eshell.el timeclock.el
-and co-wrote org-mac-message.el org-pcomplete.el
+ remember.el timeclock.el
+and co-wrote org-pcomplete.el
and changed org-clock.el org-agenda.el erc-chess.el org.el erc.el
- iswitchb.el ido.el esh-test.el Makefile.in allout.el cal-menu.el
+ iswitchb.el ido.el alloc.c allout.el auth-source.el cal-menu.el
calendar.el desktop.el diary-lib.el erc-bbdb.el erc-button.el
erc-complete.el erc-fill.el erc-ibuffer.el erc-list.el erc-match.el
- and 19 other files
+ and 22 other files
John Williams: changed etags.el
John Yates: changed hideshow.el
-Jon Anders Skorpen: changed org-publish.el
+Jon Anders Skorpen: changed ox-publish.el
-Jon Ericson: changed gnus.el spam-report.el
+Jonas Bernoulli: changed eieio.el button.el ido.el lisp-mnt.el
+ tabulated-list.el tips.texi
-Jon K Hellan: wrote utf7.el
+Jonas Hoersch: changed org-inlinetask.el org.el
-Jonathan I. Kamens: changed pop.c movemail.c rmail.el Makefile.in
- configure.in b2m.pl config.in files.el pop.h terminal.el vc.el
+Jonathan I. Kamens: changed pop.c movemail.c rmail.el configure.ac b2m.pl
+ lib-src/Makefile.in Makefile.in files.el pop.h terminal.el vc.el
gnus-sum.el jka-compr.el rmailout.el rnewspost.el sendmail.el simple.el
timezone.el vc-hooks.el
+Jonathan Leech-Pepin: wrote ox-texinfo.el
+
Jonathan Marchand: changed cpp-root.el
Jonathan Rockway: changed rcirc.el
Jonathan Yavner: wrote ses.el tcover-ses.el tcover-unsafep.el
testcover.el unsafep.el
-and changed ses.texi ses-example.ses Makefile.in edebug.el editfns.c
- files.el functions.texi subr.el variables.texi
+and changed ses.texi ses-example.ses edebug.el editfns.c files.el
+ functions.texi misc/Makefile.in subr.el variables.texi
+
+Jon Ericson: changed gnus.el spam-report.el
+
+Jon K Hellan: wrote utf7.el
+
+Joost Diepenmaat: changed org.el
-Jorgen Schaefer: wrote erc-autoaway.el erc-goodies.el erc-spelling.el
+Joost Kremers: changed reftex-toc.el
+
+Jorge A. Alfaro-Murillo: changed message.el
+
+Jorgen Schäfer: wrote erc-autoaway.el erc-goodies.el erc-spelling.el
and changed erc.el erc-track.el erc-backend.el erc-match.el erc-stamp.el
- erc-button.el erc-fill.el erc-truncate.el erc-compat.el erc-members.el
- erc-dcc.el erc-ibuffer.el erc-page.el erc-pcomplete.el erc-sound.el
- erc-bbdb.el erc-imenu.el erc-lang.el erc-list.el erc-macs.el
- erc-menu.el and 8 other files
+ erc-button.el erc-fill.el erc-members.el erc-truncate.el erc-compat.el
+ package-test.el Makefile erc-dcc.el erc-ibuffer.el erc-macs.el
+ erc-page.el erc-pcomplete.el erc-sound.el minibuffer.el package.el
+ erc-bbdb.el and 12 other files
Jose A. Ortega Ruiz: changed gnus-sum.el
Jose E. Marchesi: changed ada-mode.el gomoku.el simple.el smtpmail.el
+Jose Marino: changed idlw-shell.el
+
Joseph Arceneaux: wrote xrdb.c
and changed xterm.c xfns.c keyboard.c screen.c dispnew.c xdisp.c window.c
x-win.el fileio.c buffer.c xterm.h minibuf.c editfns.c lread.c
process.c alloc.c buffer.h files.el screen.el insdel.c emacs.c
and 106 other files
-Joseph M. Kelsey: changed dir.h fileio.c skeleton.el
+Joseph M. Kelsey: changed fileio.c skeleton.el
+
+Josh Elsasser: changed configure.ac
-Josh Elsasser: changed configure.in
+Josh Feinstein: changed erc-join.el erc.el
Josh Huber: changed mml-sec.el mml.el message.el gnus-msg.el mml2015.el
nnmail.el ChangeLog ChangeLog.1 gnus-cite.el gnus-delay.el gnus-spec.el
- mml1991.el nnultimate.el nnwfm.el gnus-cus.el gnus-smiley.el
- gnus-start.el gnus-topic.el gnus.el nnbabyl.el nndiary.el
- and 8 other files
+ mml1991.el nnwfm.el gnus-cus.el gnus-smiley.el gnus-start.el
+ gnus-topic.el gnus.el nnbabyl.el nndiary.el nnfolder.el
+ and 7 other files
Joshua Varner: changed intro.texi
Jouni K. Seppänen: changed gnus.texi nnimap.el mm-url.el
-João Cachopo: changed spam.el
-
Juan León Lahoz García: wrote wdired.el
and changed files.el perl-mode.el
+Juanma Barranquero: wrote emacs-lock.el frameset.el
+and changed src/makefile.w32-in subr.el desktop.el config.nt w32fns.c
+ lib-src/makefile.w32-in server.el emacsclient.c faces.el files.el
+ simple.el bs.el help-fns.el w32term.c org.el xdisp.c keyboard.c w32.c
+ buffer.c ido.el image.c and 1109 other files
+
Juan Pechiar: wrote ob-mscgen.el
and changed ob-octave.el
-Juanma Barranquero: wrote emacs-lock.el
-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
-
-Juergen Kreileder: changed imap.el nnimap.el
+Juergen Kreileder: changed nnimap.el
Juergen Nickelsen: wrote ws-mode.el
Julian Gehring: changed org.texi orgcard.tex
-Julian Scheid: changed tramp.el
+Julian Scheid: changed tramp.el color.el
Julien Avarre: changed gnus-fun.el
Julien Barnier: changed ob-comint.el ob-sh.el org.el
-Julien Danjou: wrote gnus-gravatar.el gravatar.el notifications.el
- shr-color.el
+Julien Danjou: wrote erc-desktop-notifications.el gnus-gravatar.el
+ gnus-notifications.el gravatar.el notifications.el shr-color.el
and co-wrote color.el
-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 82 other files
+and changed shr.el org-agenda.el gnus-art.el nnimap.el gnus-html.el
+ gnus.el message.el gnus-group.el gnus-sum.el gnus-util.el mm-decode.el
+ mm-view.el org.el gnus.texi nnir.el sieve-manage.el mm-uu.el
+ color-lab.el gnus-demon.el gnus-int.el gnus-msg.el and 96 other files
Julien Gilles: wrote gnus-ml.el
Jure Cuhalev: changed ispell.el
+Jürgen Hötzel: wrote tramp-adb.el
+and changed comint.el em-unix.el esh-util.el tramp.el url-handlers.el
+ wid-edit.el
+
Juri Linkov: wrote files-x.el misearch.el occur-tests.el
-and changed info.el isearch.el simple.el replace.el progmodes/grep.el
- dired-aux.el progmodes/compile.el dired.el startup.el faces.el files.el
- display.texi menu-bar.el descr-text.el bindings.el cus-edit.el
- image-mode.el ispell.el man.el dired-x.el log-view.el
- and 338 other files
+and changed isearch.el info.el replace.el simple.el dired-aux.el
+ progmodes/grep.el dired.el progmodes/compile.el startup.el faces.el
+ files.el menu-bar.el display.texi bindings.el descr-text.el desktop.el
+ comint.el image-mode.el man.el cus-edit.el ispell.el
+ and 353 other files
Justin Bogner: changed fortune.el
-Justin Sheehy: changed gnus-sum.el nntp.el
-
-Justus Piater: changed smtpmail.el
+Justin Gordon: changed ox-md.el
-Jérémy Compostella: changed battery.el windmove.el window.el
-
-Jérôme Marant: changed Makefile.in make-dist bindings.el configure.in
- emacsclient.c misc.texi
+Justin Sheehy: changed gnus-sum.el nntp.el
-Jürgen Hötzel: changed comint.el url-handlers.el wid-edit.el
-
-K. Shane Hartman: wrote chistory.el echistory.el electric.el emacsbug.el
- helper.el picture.el view.el
-and changed rmail.el ebuff-menu.el simple.el dired.el add-log.el
- lisp-mode.el mim-mode.el shell.el buff-menu.el buffer.c c-mode.el
- mail-utils.el more-mode.el aton.el c++-mode.el cmds.c compile.el
- files.el gud.el indent.el info.el and 13 other files
+Justus Piater: changed org-agenda.el smtpmail.el
Kahlil Hodgson: changed timeclock.el
Kai Großjohann: wrote gnus-delay.el nnir.el tramp-uu.el trampver.el
and co-wrote longlines.el tramp-sh.el tramp.el
and changed message.el gnus-agent.el gnus-sum.el files.el nnmail.el
- tramp.texi nntp.el gnus.el simple.el ange-ftp.el Makefile.in dired.el
- paragraphs.el bindings.el files.texi gnus-art.el gnus-group.el man.el
- INSTALL crisp.el fileio.c and 45 other files
+ tramp.texi nntp.el gnus.el simple.el ange-ftp.el dired.el paragraphs.el
+ bindings.el files.texi gnus-art.el gnus-group.el man.el INSTALL
+ Makefile.in crisp.el fileio.c and 43 other files
-Kai Tetzlaff: changed org-publish.el url-http.el
+Kailash C. Chowksey: changed HELLO ind-util.el kannada.el knd-util.el
+ lisp/Makefile.in loadup.el makefile.w32-in
-Kailash C. Chowksey: changed HELLO Makefile.in ind-util.el kannada.el
- knd-util.el loadup.el makefile.w32-in
+Kai Tetzlaff: changed ox-publish.el url-http.el
-Kalle Olavi Niemitalo: changed keyboard.c
+Kalle Kankare: changed image.c
-Kan-Ru Chen: changed nnir.el ecomplete.el gnus-diary.el gnus.texi
- nroff-mode.el
+Kalle Olavi Niemitalo: changed keyboard.c
Kanematsu Daiji: changed nnimap.el
-Karel Klíč: changed fileio.c files.el Makefile.in configure.in eval.c
- ftfont.c lisp.h text.texi tramp.el
+Kan-Ru Chen: changed nnir.el ecomplete.el window.el gnus-diary.el
+ gnus.texi ibuf-ext.el nnmbox.el nroff-mode.el
+
+Karel Klíč: changed fileio.c files.el configure.ac eval.c ftfont.c lisp.h
+ src/Makefile.in text.texi tramp.el
-Karl Berry: changed emacs.texi info.texi elisp.texi text.texi anti.texi
- display.texi emacs-xtra.texi faq.texi filelock.c gnu.texi macos.texi
- minibuf.texi mule.texi processes.texi texinfo.tex ada-mode.texi
- autotype.texi building.texi calc.texi cc-mode.texi cl.texi
- and 93 other files
+Karl Berry: changed info.texi emacs.texi elisp.texi text.texi anti.texi
+ display.texi efaq.texi ada-mode.texi autotype.texi calc.texi
+ cc-mode.texi cl.texi dired-x.texi ebrowse.texi ediff.texi
+ emacs-mime.texi emacs-xtra.texi eshell.texi eudc.texi filelock.c
+ forms.texi and 94 other files
Karl Chen: changed files.el align.el cc-vars.el emacsclient.c gnus-art.el
help-mode.el jka-cmpr-hook.el make-mode.el perl-mode.el
Karl Fogel: wrote bookmark.el mail-hist.el saveplace.el
and changed files.el doc-view.el image-mode.el info.el simple.el INSTALL
- autogen.sh isearch.el menu-bar.el thingatpt.el INSTALL.REPO configure
- configure.in editfns.c gnus-bookmark.el gnus-msg.el gnus-sum.el man.el
- nnmail.el org-agenda.el vc-svn.el and 4 other files
+ autogen.sh isearch.el menu-bar.el thingatpt.el vc-svn.el INSTALL.REPO
+ comint.el configure configure.ac editfns.c gnus-bookmark.el gnus-msg.el
+ gnus-sum.el man.el nnmail.el and 6 other files
Karl Heuer: changed keyboard.c lisp.h xdisp.c buffer.c xfns.c xterm.c
- alloc.c files.el frame.c window.c configure.in Makefile.in data.c
- minibuf.c editfns.c fns.c process.c fileio.c simple.el keymap.c
- indent.c and 444 other files
+ alloc.c files.el frame.c configure.ac window.c data.c minibuf.c
+ editfns.c fns.c process.c Makefile.in fileio.c simple.el keymap.c
+ indent.c and 446 other files
Karl Kleinpaste: changed gnus-sum.el gnus-art.el gnus-picon.el
gnus-score.el gnus-uu.el gnus-xmas.el gnus.el mm-uu.el mml.el nnmail.el
Karl Pflästerer: changed gnus-art.el gnus-score.el mml.el spam-stat.el
vc-svn.el
+Karol Ostrovsky: changed configure.ac src/Makefile.in
+
+Károly Lőrentey: changed xfns.c bindings.el keyboard.c menu-bar.el
+ buffer.c coding.c frame.el print.c rxvt.el simple.el spam.el sysdep.c
+ x-win.el xdisp.c xt-mouse.el xterm.c xterm.h .gdbinit AT386.el HELLO
+ README and 100 other files
+
Katsuhiro Hermit Endo: changed gnus-group.el gnus-spec.el
Katsumi Yamaoka: wrote canlock.el
-and changed gnus-art.el gnus-sum.el message.el gnus.texi mm-decode.el
- mm-util.el mm-view.el gnus-group.el mml.el rfc2047.el gnus-util.el
- gnus-start.el gnus-msg.el gnus.el shr.el nntp.el gnus-agent.el nnrss.el
- mm-uu.el nnmail.el gnus-html.el and 135 other files
+and changed gnus-art.el message.el gnus-sum.el gnus.texi mm-decode.el
+ mm-util.el mm-view.el gnus-msg.el gnus-util.el mml.el gnus-group.el
+ rfc2047.el gnus-start.el gnus.el shr.el nntp.el gnus-agent.el nnrss.el
+ mm-uu.el nnmail.el gmm-utils.el and 146 other files
Kaushik Srenevasan: changed gdb-mi.el
Kayvan Sylvan: changed supercite.el
-Kazuhiro Ito: changed coding.c flow-fill.el
+Kazuhiro Ito: changed coding.c flow-fill.el font.c keyboard.c
+ make-mode.el starttls.el xdisp.c
Kazushi Marukawa: changed filelock.c hexl.c profile.c unexalpha.c
Keith Packard: changed font.c
-Ken Brown: changed configure.in cygwin.h sheap.c browse-url.el gmalloc.c
- vm-limit.c callproc.c dired.c emacs.c fileio.c gdb-mi.el loadup.el
- mem-limits.h unexcw.c
+Kelly Dean: changed simple.el help-mode.el desktop.el files.el lisp.el
+ register.el easy-mmode.el fileio.c help-fns.el help-macro.el help.el
+ keyboard.c package-x.el rect.el windmove.el winner.el
+
+Kelvin White: changed erc.el erc.texi NEWS.24 erc-backend.el erc-ring.el
+ erc-stamp.el
+
+Ken Brown: changed configure.ac gmalloc.c sheap.c cygwin.h emacs.c
+ browse-url.el conf_post.h emacs.rc.in unexcw.c w32term.c alloc.c
+ dispextern.h frame.c lisp.h src/Makefile.in vm-limit.c xgselect.c
+ CPP-DEFINES callproc.c config.nt dired.c and 17 other files
Ken Brush: changed emacsclient.c
+Kenichi Handa: wrote composite.el decoder-tests.el isearch-x.el
+ language/cyrillic.el ps-bdf.el py-punct.el pypunct-b5.el thai-word.el
+and co-wrote ps-def.el ps-mule.el ps-print.el ps-samp.el quail.el
+and changed coding.c mule-cmds.el mule.el fontset.c charset.c xdisp.c
+ font.c fontset.el xterm.c fileio.c mule-conf.el characters.el fns.c
+ ftfont.c mule-diag.el coding.h charset.h ccl.c xfaces.c editfns.c
+ composite.c and 374 other files
+
+Kenichi Okada: co-wrote sasl-cram.el sasl-digest.el
+
+Kenjiro Nakayama: changed eww.el mm-url.el
+
Ken Laprade: changed simple.el
Ken Manheimer: wrote allout-widgets.el allout.el icomplete.el
locked-encrypted.xpm pgg-pgp.el pgg-pgp5.el unlocked-encrypted.png
unlocked-encrypted.xpm README edebug.el pgg.texi tips.texi
-Ken Raeburn: changed lisp.h lread.c Makefile.in alloc.c buffer.c fns.c
- keyboard.c minibuf.c coding.c editfns.c fileio.c keymap.c xdisp.c
- configure.in emacs.c undo.c xfns.c xterm.c charset.h coding.h fontset.c
- and 93 other files
-
-Ken Stevens: wrote ispell.el
+Kenneth Stailey: changed alpha.h configure.ac ns32000.h openbsd.h pmax.h
+ sparc.h unexalpha.c unexelf.c
-Kenichi Handa: wrote composite.el isearch-x.el language/cyrillic.el
- ps-bdf.el py-punct.el pypunct-b5.el thai-word.el
-and co-wrote ps-def.el ps-mule.el ps-print.el ps-samp.el quail.el
-and changed coding.c mule-cmds.el mule.el fontset.c charset.c xdisp.c
- fontset.el font.c xterm.c Makefile.in fileio.c mule-conf.el
- characters.el fns.c ftfont.c mule-diag.el charset.h ccl.c coding.h
- xfaces.c editfns.c and 388 other files
+Ken Olum: changed mail/rmailmm.el message.el rmail.el
-Kenichi Okada: co-wrote sasl-cram.el sasl-digest.el
+Ken Raeburn: changed lisp.h lread.c alloc.c buffer.c fns.c keyboard.c
+ minibuf.c coding.c editfns.c fileio.c keymap.c xdisp.c configure.ac
+ emacs.c undo.c xfns.c xterm.c charset.h coding.h fontset.c process.c
+ and 96 other files
-Kenneth Stailey: changed alpha.h configure.in ns32000.h openbsd.h pmax.h
- sparc.h unexalpha.c unexelf.c
+Ken Stevens: wrote ispell.el
Kentaro Ohkouchi: changed emacs.png README emacs.ico emacs.svg
emacs16_mac.png emacs24_mac.png emacs256_mac.png emacs32_mac.png
nnagent.el nnheader.el gnus-async.el gnus-registry.el gnus-salt.el
gnus-uu.el and 3 other files
-Kevin Layer: changed w32proc.c
+Kevin Layer: changed mml.el w32proc.c
-Kevin Rodgers: changed compile.el mailabbrev.el dired-x.el files.el
- progmodes/compile.el ange-ftp.el byte-opt.el desktop.el diff-mode.el
+Kevin Rodgers: changed compile.el mailabbrev.el progmodes/compile.el
+ dired-x.el files.el ange-ftp.el byte-opt.el desktop.el diff-mode.el
dired-x.texi ffap.el files.texi flyspell.el isearch.el killing.texi
lisp.el loadhist.el mailalias.el menu-bar.el print.c progmodes/grep.el
and 8 other files
Kevin Ryde: wrote info-xref.el
and changed info-look.el info.el checkdoc.el cl.texi compilation.txt
- arc-mode.el ffap.el gnus-art.el gnus-sum.el mule.el os.texi
- progmodes/compile.el MORE.STUFF browse-url.el copyright.el dig.el
- etags.c flyspell.el keyboard.c mailcap.el man.el and 80 other files
+ etags.c arc-mode.el ffap.el gnus-art.el gnus-sum.el mule.el os.texi
+ progmodes/compile.el woman.el MORE.STUFF browse-url.el copyright.el
+ dig.el files.el flyspell.el keyboard.c and 85 other files
Kim F. Storm: wrote bindat.el cua-base.el cua-gmrk.el cua-rect.el ido.el
keypad.el kmacro.el
macterm.c alloc.c fns.c xfaces.c keymap.c xfns.c xterm.h .gdbinit
and 250 other files
+Kimit Yada: changed copyright.el
+
Kim-Minh Kaplan: changed gnus-picon.el gnus-sum.el gnus-start.el
- gnus-win.el gnus-xmas.el gnus.texi imap.el message.el nndraft.el
- nnml.el
+ gnus-win.el gnus-xmas.el gnus.texi message.el nndraft.el nnml.el
-Kimit Yada: changed copyright.el
+Kirill A. Korinskiy: changed fortune.el
-Kirk Kelsey: changed make-mode.el
+Kirk Kelsey: changed make-mode.el vc-hg.el
Kishore Kumar: changed terminal.el
Klaus Straubinger: changed url-http.el url-history.el pcmpl-rpm.el
url-cookie.el url.el
-Klaus Zeitler: changed configure.in files.el sh-script.el vcursor.el
+Klaus Zeitler: changed configure.ac files.el sh-script.el vcursor.el
Knut Anders Hatlen: changed nnimap.el imap.el
Kobayashi Yasuhiro: changed w32fns.c configure.bat indent.c info.el
w32term.c w32term.h window.c xfns.c
+Kodi Arfer: changed org.texi ox-html.el
+
Konrad Hinsen: wrote org-eshell.el
and changed ob-python.el
+Konstantin Kliakhandler: changed org-agenda.el
+
Konstantin Novitsky: changed progmodes/python.el
Kristoffer Grönlund: wrote wombat-theme.el
+K. Shane Hartman: wrote chistory.el echistory.el electric.el emacsbug.el
+ helper.el picture.el view.el
+and changed rmail.el ebuff-menu.el simple.el dired.el add-log.el
+ lisp-mode.el mim-mode.el shell.el buff-menu.el buffer.c c-mode.el
+ mail-utils.el more-mode.el aton.el c++-mode.el cmds.c compile.el
+ files.el gud.el indent.el info.el and 13 other files
+
Kurt B. Kaiser: changed message.el
-Kurt Hornik: wrote octave-inf.el
-and co-wrote octave-mod.el
-and changed battery.el ielm.el octave-hlp.el term.el
+Kurt Hornik: co-wrote octave.el
+and changed battery.el ielm.el octave-hlp.el octave-mode.texi term.el
Kurt Swanson: changed gnus-art.el gnus-salt.el gnus-sum.el gnus-ems.el
gnus-group.el gnus-msg.el gnus-score.el gnus-util.el nnmail.el window.c
Kyle Jones: wrote life.el
and changed saveconf.el buffer.c mail-utils.el sendmail.el
+Kyle Meyer: changed ox.el
+
Kyotaro Horiguchi: changed coding.c indent.c
-Károly Lőrentey: changed xfns.c bindings.el keyboard.c menu-bar.el
- buffer.c coding.c frame.el print.c rxvt.el simple.el spam.el sysdep.c
- x-win.el xdisp.c xt-mouse.el xterm.c xterm.h .gdbinit AT386.el HELLO
- Makefile.in and 101 other files
+Laimonas Vėbra: changed european.el
Lara Rios: co-wrote cal-menu.el
Lars Balker Rasmussen: changed gnus-art.el gnus-agent.el message.el
-Lars Brinkhoff: changed building.texi config.in configure.in editfns.c
- fns.c os.texi
+Lars Brinkhoff: changed building.texi configure.ac editfns.c fns.c
+ os.texi
Lars Hansen: changed desktop.el tramp.el info.el mh-e.el dired-x.el
dired-x.texi dired.el ls-lisp.el rmail.el dired.c files.texi
Lars Lindberg: wrote msb.el
and co-wrote dabbrev.el imenu.el
-Lars Ljung: changed esh-ext.el
-
-Lars Magne Ingebrigtsen: wrote compface.el dns.el ecomplete.el
- format-spec.el gnus-agent.el gnus-art.el gnus-async.el gnus-bcklg.el
- gnus-cache.el gnus-demon.el gnus-draft.el gnus-dup.el gnus-eform.el
- gnus-ems.el gnus-fun.el gnus-group.el gnus-html.el gnus-int.el
- gnus-logic.el gnus-picon.el gnus-range.el gnus-salt.el gnus-spec.el
- gnus-srvr.el gnus-start.el gnus-sum.el gnus-undo.el gnus-util.el
- gnus-uu.el gnus-win.el ietf-drums.el mail-parse.el mail-prsvr.el
- mail-source.el message.el messcompat.el mm-view.el mml.el netrc.el
- network-stream.el nnagent.el nndir.el nndraft.el nngateway.el nnmail.el
- nnoo.el nntp.el nnweb.el qp.el rfc2045.el rfc2231.el rtree.el
- score-mode.el shr.el spam.el url-queue.el
+Lars Ljung: changed esh-ext.el isearch.el
+
+Lars Magne Ingebrigtsen: wrote compface.el dns.el dom.el ecomplete.el
+ eww.el format-spec.el gnus-agent.el gnus-art.el gnus-async.el
+ gnus-bcklg.el gnus-cache.el gnus-cloud.el gnus-demon.el gnus-draft.el
+ gnus-dup.el gnus-eform.el gnus-ems.el gnus-fun.el gnus-group.el
+ gnus-html.el gnus-int.el gnus-logic.el gnus-picon.el gnus-range.el
+ gnus-salt.el gnus-spec.el gnus-srvr.el gnus-start.el gnus-sum.el
+ gnus-undo.el gnus-util.el gnus-uu.el gnus-win.el ietf-drums.el
+ mail-parse.el mail-prsvr.el mail-source.el message.el messcompat.el
+ mm-archive.el mm-view.el mml.el netrc.el network-stream.el nnagent.el
+ nndir.el nndraft.el nngateway.el nnmail.el nnoo.el nntp.el nnweb.el
+ nsm.el qp.el rfc2045.el rfc2231.el rtree.el score-mode.el shr.el
+ spam.el url-domsuf.el url-queue.el zlib-tests.el
and co-wrote gnus-kill.el gnus-mh.el gnus-msg.el gnus-score.el
gnus-topic.el gnus.el gssapi.el mailcap.el mm-bodies.el mm-decode.el
mm-encode.el mm-util.el nnbabyl.el nndoc.el nneething.el nnfolder.el
nnheader.el nnimap.el nnmbox.el nnmh.el nnml.el nnspool.el nnvirtual.el
rfc2047.el time-date.el
-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 210 other files
+and changed gnus.texi gnus-cite.el smtpmail.el pop3.el gnus-xmas.el
+ gnutls.c auth-source.el url-http.el files.el proto-stream.el subr.el
+ dired.el simple.el image.c nnrss.el text.texi xml.c editfns.c
+ gnus-nocem.el gnus-registry.el message.texi and 240 other files
Lars Rasmusson: changed ebrowse.c
Laurent Martelli: changed mm-decode.el
Lawrence Mitchell: wrote erc-backend.el erc-log.el
-and changed erc.el org-latex.el org.el erc-match.el erc-nets.el
- erc-nickserv.el org-exp.el browse-url.el erc-button.el erc-compat.el
- erc-dcc.el erc-fill.el erc-list.el erc-track.el ielm.el ob.el
- org-html.el cl-macs.el erc-autoaway.el erc-autojoin.el erc-bbdb.el
- and 23 other files
+and changed erc.el ox-latex.el org.el ox.el erc-match.el erc-nets.el
+ erc-nickserv.el ox-html.el browse-url.el erc-button.el erc-compat.el
+ erc-dcc.el erc-fill.el erc-list.el erc-track.el ielm.el ob.el Makefile
+ cl-macs.el erc-autoaway.el erc-autojoin.el and 25 other files
Lawrence R. Dodd: co-wrote dired-x.el
and changed fortran.el ispell.el sendmail.el cmuscheme.el comint.el
lisp.el man.el minibuf.c rcs2log rmail.el simple.el terminal.el
text-mode.el tpu-edt.el and 3 other files
+Lee Duhem: changed eval.c
+
Leigh Stoller: changed emacsclient.c server.el
-Lennart Borgman: wrote ert-x.el org-freemind.el
+Lennart Borgman: co-wrote ert-x.el
and changed nxml-mode.el tutorial.el window.el ada-xref.el buff-menu.el
emacs-lisp/debug.el emacsclient.c filesets.el flymake.el help-fns.el
- isearch.el linum.el lisp-mode.el mouse.el recentf.el remember.el
- replace.el ruby-mode.el shell.el texinfmt.el w32term.c w32term.h
+ isearch.el linum.el lisp-mode.el lisp.el mouse.el recentf.el
+ remember.el replace.el ruby-mode.el shell.el texinfmt.el
+ and 3 other files
Lennart Staflin: changed dired.el diary-ins.el diary-lib.el tq.el xdisp.c
-Leo Liu: changed rcirc.el ido.el abbrev.el makefile.w32-in subr.el
- Makefile.in deps.mk diff-mode.el dnd.el em-hist.el erc.el files.el
- fns.c font-lock.el footnote.el gl-comp.m4 gnulib.mk help-mode.el
- iswitchb.el minibuf.c minibuffer.el and 62 other files
+Leo Liu: wrote calc-tests.el pcmpl-x.el
+and changed octave.el ido.el rcirc.el files.el subr.el eldoc.el simple.el
+ flymake.el smie.el abbrev.el lisp-mode.el progmodes/python.el
+ cl-extra.el cl-macs.el emacs-lisp/cl-lib.el progmodes/compile.el
+ register.el rng-valid.el window.el bindings.el cfengine.el
+ and 157 other files
Leonard H. Tower Jr.: changed rnews.el rnewspost.el emacsbug.el
rmailout.el sendmail.el
-Levin Du: changed parse-time.el
+Leonardo Nobrega: changed progmodes/python.el
+
+Leonard Randall: changed org-bibtex.el reftex-parse.el
+
+Leo P. White: changed eieio-custom.el
+
+Levin Du: changed org-clock.el parse-time.el
-Lewis Perin: changed emacs.manifest
+Le Wang: changed org-src.el comint.el hilit-chg.el misc.el
+
+Lewis Perin: changed emacs-x86.manifest
Liam Healy: changed outline.el
-Liang Wang: changed etags.el
+Liam Stitt: changed url-file.el url-vars.el
-Litvinov Sergey: changed ob-maxima.el ob-octave.el
+Liang Wang: changed etags.el
Lloyd Zusman: changed mml.el pgg-gpg.el
-Luc Teirlinck: wrote help-at-pt.el
-and changed files.el autorevert.el cus-edit.el subr.el simple.el
- frames.texi startup.el display.texi files.texi Makefile.in dired.el
- comint.el custom.texi emacs.texi fns.c frame.el ielm.el minibuf.texi
- modes.texi variables.texi buffers.texi and 212 other files
+Lluís Vilanova: changed ede/linux.el
Luca Capello: changed mm-encode.el
delsel.el disass.el faces.el font-lock.el lmenu.el mailabbrev.el
select.el xfaces.c xselect.c
-Ludovic Courtes: changed nnregistry.el
+Luc Teirlinck: wrote help-at-pt.el
+and changed files.el autorevert.el cus-edit.el subr.el simple.el
+ frames.texi startup.el display.texi files.texi dired.el comint.el
+ modes.texi custom.texi emacs.texi fns.c frame.el ielm.el minibuf.texi
+ variables.texi buffers.texi commands.texi and 214 other files
Ludovic Courtès: wrote nnregistry.el
-and changed gnus.texi
+and changed configure.ac gnus.texi
+
+Luis Felipe López Acevedo: changed TUTORIAL.es
+
+Luis R Anaya: co-wrote ox-man.el
Lukas Huonker: changed tetris.el
Łukasz Demianiuk: changed erc.el
-Łukasz Stelmach: changed cookie1.el message.el org-agenda.el org-bbdb.el
- org-exp.el org-html.el org.el
+Łukasz Stelmach: changed cookie1.el gtkutil.c message.el org-agenda.el
+ org-bbdb.el org.el ox-html.el ox.el
+
+Luke Lee: changed hideif.el
Lute Kamstra: changed modes.texi emacs-lisp/debug.el generic-x.el
- generic.el font-lock.el simple.el subr.el Makefile.in battery.el
- debugging.texi easy-mmode.el elisp.texi emacs-lisp/generic.el
- hl-line.el info.el basic.texi bindings.el calc.el cmdargs.texi
- diff-mode.el doclicense.texi and 291 other files
+ generic.el font-lock.el simple.el subr.el battery.el debugging.texi
+ easy-mmode.el elisp.texi emacs-lisp/generic.el hl-line.el info.el
+ octave.el basic.texi bindings.el calc.el cmdargs.texi diff-mode.el
+ doclicense.texi and 291 other files
Lynn Slater: wrote help-macro.el
Maciek Pasternacki: changed nnrss.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
- org-latex.el org-table.el process.c quail/cyrillic.el
- and 10 other files
+Madan Ramakrishnan: changed org-agenda.el
+
+Magnus Henoch: wrote sasl-scram-rfc-tests.el sasl-scram-rfc.el
+and changed url-http.el ispell.el url.el dbusbind.c dns.el configure.ac
+ nnmaildir.el sasl.el url-gw.el url-parse.el url-proxy.el autoinsert.el
+ cl.texi cyrillic.el dbus.el gnus.texi hashcash.el image.c log-edit.el
+ message.el org-clock.el and 14 other files
Malcolm Purvis: changed spam-stat.el
Manoj Srivastava: wrote manoj-dark-theme.el
-Manuel Giraud: changed org-html.el org-publish.el org.texi
+Manuel Giraud: changed ox-html.el ox-publish.el org.texi
Manuel Gómez: changed speedbar.el
Manuel Serrano: wrote flyspell.el
+Marcelo Toledo: changed TUTORIAL.pt_BR TUTORIAL.cn TUTORIAL.cs
+ TUTORIAL.de TUTORIAL.es TUTORIAL.fr TUTORIAL.it TUTORIAL.ja TUTORIAL.ko
+ TUTORIAL.pl TUTORIAL.ro TUTORIAL.ru TUTORIAL.sk TUTORIAL.sl TUTORIAL.th
+ TUTORIAL.zh add-log.el european.el
+
Marc Fleischeuers: changed files.el
Marc Girod: changed informat.el rmail.el rmailsum.el sendmail.el
Marc Lefranc: changed gnus-art.el
-Marc Shapiro: co-wrote bibtex.el
-
-Marcelo Toledo: changed TUTORIAL.pt_BR TUTORIAL.cn TUTORIAL.cs
- TUTORIAL.de TUTORIAL.es TUTORIAL.fr TUTORIAL.it TUTORIAL.ja TUTORIAL.ko
- TUTORIAL.pl TUTORIAL.ro TUTORIAL.ru TUTORIAL.sk TUTORIAL.sl TUTORIAL.th
- TUTORIAL.zh add-log.el european.el
-
Marco Melgazzi: changed term.el
+Marco Wahl: changed org-agenda.el
+
Marco Walther: changed mips-siemens.h unexelfsni.c unexsni.c
-Marcus G. Daniels: changed xterm.c configure.in lwlib-Xm.c lwlib.c
- xdisp.c xfns.c Makefile.in dispnew.c xmenu.c alloc.c config.in
- editfns.c emacs.c frame.c frame.h irix5-0.h keyboard.c linux.h
- lwlib-Xm.h lwlib.h ntterm.c and 11 other files
+Marc Shapiro: co-wrote bibtex.el
+
+Marcus G. Daniels: changed xterm.c configure.ac lwlib-Xm.c lwlib.c
+ xdisp.c xfns.c dispnew.c src/Makefile.in xmenu.c alloc.c editfns.c
+ emacs.c frame.c frame.h irix5-0.h keyboard.c linux.h lwlib-Xm.h lwlib.h
+ ntterm.c ptx4.h and 10 other files
Marcus Harnisch: changed gnus-art.el
+Marcus Karlsson: changed image.c
+
Marek Martin: changed nnfolder.el
Marien Zwart: changed progmodes/python.el
erc-netsplit.el erc-networks.el erc-notify.el erc-speedbar.el
erc-stamp.el erc-track.el erc-xdcc.el
and co-wrote erc-fill.el
-and changed erc.el erc-dcc.el erc-speak.el erc-bbdb.el erc-complete.el
- erc-pcomplete.el erc-chess.el erc-list.el battery.el erc-match.el
- erc-autojoin.el erc-nets.el erc-nickserv.el erc-ring.el artist.el
- cpp-root.el db-el.el db-global.el db-javascript.el db.el diff.el
- and 24 other files
+and changed erc.el erc-dcc.el erc-speak.el Makefile erc-bbdb.el
+ erc-complete.el erc-pcomplete.el erc-chess.el erc-list.el battery.el
+ erc-match.el erc-autojoin.el erc-nets.el erc-nickserv.el erc-ring.el
+ org.texi artist.el cpp-root.el db-el.el db-global.el db-javascript.el
+ and 34 other files
Mark A. Hershberger: changed xml.el nnrss.el mm-url.el cperl-mode.el
- isearch.el vc-bzr.el Makefile.in NXML-NEWS cc-mode.texi
- compilation.txt ede.texi eieio.texi esh-mode.el flymake.el
- gnus-group.el makefile.w32-in nxml-mode.texi progmodes/compile.el
+ isearch.el vc-bzr.el NXML-NEWS cc-mode.texi compilation.txt ede.texi
+ eieio.texi esh-mode.el flymake.el gnus-group.el misc/Makefile.in
+ misc/makefile.w32-in nxml-mode.texi progmodes/compile.el
progmodes/python.el programs.texi and 7 other files
+Mark Davies: changed amdx86-64.h configure configure.ac hp800.h
+ lib-src/Makefile.in netbsd.h ralloc.c sh3el.h sort.el
+
Mark D. Baushke: changed mh-e.el mh-utils.el mh-mime.el mh-comp.el
- mh-search.el mh-customize.el mh-identity.el mh-seq.el mh-speed.el
- mh-funcs.el mh-alias.el etags.c mh-junk.el mh-tool-bar.el
+ mh-search.el mh-customize.el Makefile mh-identity.el mh-seq.el
+ mh-speed.el mh-funcs.el mh-alias.el etags.c mh-junk.el mh-tool-bar.el
mh-xemacs-compat.el pgg-gpg.el
-Mark Davies: changed Makefile.in amdx86-64.h configure configure.in
- hp800.h netbsd.h ralloc.c sh3el.h sort.el
-
Mark Diekhans: changed files.el progmodes/compile.el subr.el
-Mark H. Weaver: changed comint.el
+Mark E. Shoulson: changed org.el org-entities.el
Mark Hood: changed gnus-uu.el
+Mark H. Weaver: changed comint.el
+
Mark Lambert: changed process.c process.h
-Mark Lillibridge: changed rmail.el mail-utils.el unrmail.el
+Mark Laws: changed dispnew.c emacs.c emacsclient.c frame.el frameset.el
+ keyboard.c lisp.h minibuf.c ms-w32.h server.el
+
+Mark Lillibridge: changed rmail.el mail-utils.el mail/rmailmm.el
+ unrmail.el
Mark Mitchell: changed font-lock.el
Mark Neale: changed fortran.el
+Marko Kohtala: changed info.el
+
Mark Osbourne: changed hexl-mode.el
-Mark Plaksin: changed nnrss.el term.el
+Mark Oteiza: changed eww.el files.el
-Mark Shoulson: changed org.el
+Mark Plaksin: changed nnrss.el term.el
Mark Thomas: changed flow-fill.el gnus-sum.el gnus-util.el nnmail.el
Mark Triggs: changed nnir.el
-Mark W Maimone: changed mpuz.el
-
-Mark W. Eichin: changed keyboard.c xterm.c
-
-Marko Kohtala: changed info.el
-
Markus Armbruster: changed avoid.el
Markus Gritsch: changed ebrowse.el
+Markus Hauck: changed org-agenda.el
+
Markus Heiser: changed gud.el
Markus Heritsch: co-wrote ada-mode.el ada-stmt.el ada-xref.el
Markus Holmberg: changed thingatpt.el
Markus Rost: wrote cus-test.el
-and changed cus-edit.el Makefile.in files.el progmodes/compile.el
- rmail.el tex-mode.el find-func.el rmailsum.el simple.el cus-dep.el
- dired.el mule-cmds.el rmailout.el checkdoc.el configure.in custom.el
- emacsbug.el gnus.el help-fns.el ls-lisp.el mwheel.el
- and 122 other files
+and changed cus-edit.el files.el progmodes/compile.el rmail.el
+ tex-mode.el find-func.el rmailsum.el simple.el cus-dep.el dired.el
+ mule-cmds.el rmailout.el checkdoc.el configure.ac custom.el emacsbug.el
+ gnus.el help-fns.el ls-lisp.el mwheel.el sendmail.el
+ and 126 other files
Markus Sauermann: changed lisp-mode.el
flyspell.el handwrite.el internals.texi proced.el ps-mode.el
speedbar.el subr.el tumme.el widget.texi xterm.c
+Mark W. Eichin: changed keyboard.c xterm.c
+
+Mark W Maimone: changed mpuz.el
+
Marshall T. Vandegrift: changed gnus-fun.el
Martin Blais: co-wrote rst.el
+and changed progmodes/compile.el
Martin Boyer: changed bibtex.el menu-bar.el
Martin Larose: changed message.el
Martin Lorentzon: wrote vc-annotate.el
-and changed vc.el vc-cvs.el vc-hooks.el vc-rcs.el vc-sccs.el
+and changed vc.el vc-cvs.el vc-rcs.el vc-sccs.el vc-hooks.el
Martin Neitzel: changed supercite.el
Martin Pohlack: changed iimage.el pc-select.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 xdisp.c font-lock.el
- help-fns.el lisp.h mouse.el wid-edit.el and 137 other files
+Martin Rudalics: changed window.el window.c windows.texi frame.c xdisp.c
+ w32term.c xterm.c w32fns.c help.el frame.el xfns.c buffer.c frames.texi
+ cus-start.el window.h dired.el display.texi dispnew.c keyboard.c
+ mouse.el files.el and 173 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
cc-fonts.el cc-langs.el cc-menus.el cc-mode.el cc-styles.el cc-vars.el
-and changed cc-fix.el cc-mode.texi Makefile.in cc-guess.el cc-mode-19.el
- nnimap.el ack.texi awk-mode.el cc-awk.el cc-lobotomy.el cc-make.el
- cc-style.el cc-subword.el files.el generic-x.el gnus-agent.el
- gnus-art.el mm-decode.el simple.el
+and changed cc-fix.el nnimap.el cc-guess.el cc-mode-19.el cc-mode.texi
+ lisp/Makefile.in ack.texi awk-mode.el cc-awk.el cc-lobotomy.el
+ cc-make.el cc-subword.el files.el generic-x.el gnus-agent.el
+ gnus-art.el gnus-demon.el mm-decode.el simple.el
Martin Svenson: changed progmodes/python.el
nnspool.el nnvirtual.el time-date.el
and changed gnuspost.el
-Masatake Yamato: wrote ld-script.el subword.el
+Masashi Fujimoto: changed battery.el
+
+Masatake Yamato: wrote add-log-tests.el imenu-test.el ld-script.el
+ subword.el
and co-wrote cc-guess.el
and changed etags.el asm-mode.el hexl.el xdisp.c bindings.el man.el
xfaces.c simple.el vc.el wid-edit.el add-log.el etags.c faces.el
- pcvs.el progmodes/compile.el register.el ruler-mode.el buffer.c
- cc-langs.el cus-face.el dired-x.el and 73 other files
+ pcvs.el progmodes/compile.el register.el ruler-mode.el sh-script.el
+ buffer.c cc-langs.el cus-face.el and 79 other files
Masayuki Ataka: changed texinfmt.el texinfo.el characters.el cmuscheme.el
make-mode.el
Mathias Dahl: wrote image-dired.el
and changed tumme.el dired.el dired.texi
-Mathias Megyei: changed Makefile.in
+Mathias Megyei: changed lisp/Makefile.in
-Mats Lidell: changed TUTORIAL.sv european.el gnus-art.el
+Mats Lidell: changed TUTORIAL.sv european.el gnus-art.el org-element.el
-Matt Hodges: changed textmodes/table.el faces.el iswitchb.el simple.el
- tmm.el cal-menu.el calendar.el calendar.texi diary-lib.el easymenu.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 Armstrong: changed gnus-topic.el gnus.el message.el
-Matt Lundin: changed org-agenda.el org-bibtex.el org-footnote.el org.el
-
-Matt Pharr: changed message.el
-
-Matt Simmons: changed message.el
+Matt Curtis: changed pulse.el
-Matt Swift: changed dired.el editfns.c lisp-mode.el mm-decode.el
- outline.el progmodes/compile.el rx.el simple.el startup.el
+Matt Fidler: changed package.el
Matthew Junker: changed cal-tex.el
-Matthew Luckie: changed configure.in
+Matthew Leach: changed arc-mode.el font-lock.el
+
+Matthew Luckie: changed configure.ac
Matthew Mundell: changed calendar.texi diary-lib.el files.texi
type-break.el debugging.texi display.texi edebug.texi editfns.c eval.c
objects.texi os.texi positions.texi searching.texi subr.el text.texi
and 3 other files
+Matthias Dahl: changed faces.el
+
Matthias Förste: changed files.el
+Matthias Meulien: changed bookmark.el progmodes/python.el buff-menu.el
+ prog-mode.el simple.el tabify.el vc-dir.el
+
Matthias Wiehl: changed gnus.el
Matthieu Devin: wrote delsel.el
Matthieu Moy: changed gnus-msg.el message.el
+Matt Hodges: changed textmodes/table.el faces.el iswitchb.el simple.el
+ tmm.el cal-menu.el calendar.el calendar.texi diary-lib.el easymenu.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.el org-bibtex.el org-footnote.el
+ ox-publish.el org-bbdb.el org-datetree.el org-gnus.el
+
+Matt McClure: changed progmodes/python.el
+
+Matt Pharr: changed message.el
+
+Matt Simmons: changed message.el
+
+Matt Swift: changed dired.el editfns.c lisp-mode.el mm-decode.el
+ outline.el progmodes/compile.el rx.el simple.el startup.el
+
Maxime Edouard Robert Froumentin: changed gnus-art.el mml.el
-Michael Albinus: wrote dbus.el secrets.el tramp-cmds.el tramp-compat.el
- tramp-ftp.el tramp-gvfs.el tramp-gw.el tramp-smb.el xesam.el
- zeroconf.el
+Max Mikhanosha: changed org-agenda.el org-habit.el org.el
+
+Memnon Anon: changed org.texi
+
+Micah Anderson: changed spook.lines
+
+Michael Albinus: wrote dbus-tests.el dbus.el file-notify-tests.el
+ filenotify.el secrets.el tramp-cmds.el tramp-compat.el tramp-ftp.el
+ tramp-gvfs.el tramp-gw.el tramp-smb.el tramp-tests.el url-tramp.el
+ vc-tests.el xesam.el zeroconf.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 tramp-util.el tramp-uu.el notifications.el simple.el
- auth-source.el dired-aux.el configure.in em-unix.el fileio.c
- and 66 other files
+and changed tramp.texi dbusbind.c trampver.texi trampver.el tramp-adb.el
+ ange-ftp.el dbus.texi files.el tramp-fish.el autorevert.el files.texi
+ tramp-imap.el notifications.el configure.ac tramp-vc.el lisp.h
+ lisp/Makefile.in simple.el tramp-uu.el em-unix.el keyboard.c
+ and 116 other files
-Michael Ben-Gershon: changed acorn.h configure.in riscix1-1.h riscix1-2.h
+Michael Ben-Gershon: changed acorn.h configure.ac riscix1-1.h riscix1-2.h
unexec.c
-Michael Brand: changed org.el org-agenda.el org.texi org-table.el
+Michael Brand: changed org.texi org-table.el org.el org-agenda.el
+ org-capture.el ob-tangle.el org-feed.el org-id.el org-list.el
+
+Michaël Cadilhac: changed browse-url.el fr-dired-ref.tex gnus-sum.el
+ gnus.texi ido.el Makefile emacsbug.el files.el fill.el flyspell.el
+ fr-refcard.tex ispell.el meta-mode.el nnrss.el anti.texi battery.el
+ blackbox.el bs.el calccard.tex callint.c cmuscheme.el
+ and 58 other files
Michael D. Ernst: wrote reposition.el
and changed dired-x.el uniquify.el ispell.el bibtex.el rmail.el dired.el
complete.el fill.el shadow.el texnfo-upd.el vc.el allout.el comint.el
cust-print.el edebug.el and 28 other files
+Michael Downes: changed gnus-sum.el
+
Michael D. Prange: wrote fortran.el
and changed tex-mode.el
-Michael Downes: changed gnus-sum.el
+Michael Gauland: co-wrote ob-scheme.el
+and changed ebnf2ps.el org-src.el
Michael Gschwind: wrote iso-cvt.el
Michael Harnois: changed nnimap.el
+Michael Heerdegen: changed dired.el easy-mmode.el eldoc.el wdired.el
+
+Michael Hoffman: changed term.el
+
Michael Hotchin: changed progmodes/compile.el
Michael I. Bushnell: changed rmail.el simple.el callproc.c gnu.h gnus.el
lread.c process.c screen.el search.c sendmail.el startup.el timer.c
-Michael K. Johnson: changed configure.in emacs.c intel386.h linux.h
- mem-limits.h process.c sysdep.c syssignal.h systty.h template.h
- unexcoff.c
-
Michael Kifer: wrote ediff-diff.el ediff-help.el ediff-hook.el
ediff-init.el ediff-merg.el ediff-mult.el ediff-ptch.el ediff-util.el
ediff-vers.el ediff-wind.el ediff.el viper-cmd.el viper-ex.el
viper-init.el viper-keym.el viper-macs.el viper-mous.el viper-util.el
viper.el
and co-wrote cal-x.el
-and changed viper*.el ediff*.el viper.texi ediff.texi ediff-hooks.el
- ediff-merge.el menu-bar.el appt.el desktop.el ediff-meta.el
- viper-mouse.el
+and changed viper*.el ediff*.el viper.texi ediff.texi 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-contacts-wl.el org-docbook.el org-html.el org-latex.el org-table.el
- org.el
+Michael K. Johnson: changed configure.ac emacs.c process.c sysdep.c
+ syssignal.h systty.h unexcoff.c
+
+Michael Marchionna: changed nsterm.m
+
+Michael Markert: changed ob.el org-agenda.el org-docbook.el org-table.el
+ org.el ox-ascii.el ox-html.el ox-latex.el
Michael McNamara: co-wrote verilog-mode.el
-Michael Olson: changed erc.el erc-backend.el erc.texi erc-track.el
+Michael Olson: changed erc.el erc-backend.el Makefile erc-track.el
erc-log.el erc-stamp.el erc-autoaway.el erc-dcc.el erc-goodies.el
- erc-list.el erc-compat.el erc-identd.el ERC-NEWS erc-bbdb.el
+ erc-list.el erc-compat.el erc-identd.el erc.texi ERC-NEWS erc-bbdb.el
erc-match.el erc-notify.el erc-ibuffer.el erc-services.el remember.el
- erc-button.el erc-nicklist.el and 60 other files
+ erc-button.el and 62 other files
Michael Piotrowski: changed gnus-art.el gnus-sum.el ps-print.el
Michael R. Cook: changed gnus-sum.el gnus-topic.el gnus-art.el
-Michael R. Mauger: changed sql.el emacsclient.c cua-base.el custom.el
- facemenu.el recentf.el replace.el tramp.el w32fns.c
+Michael R. Mauger: changed sql.el emacsclient.c comint.el cua-base.el
+ custom.el facemenu.el recentf.el replace.el tramp.el w32fns.c
Michael R. Wolf: changed ange-ftp.el
Michael Staats: wrote pc-select.el
-Michael Welsh Duggan: changed lisp.h nnimap.el sh-script.el w32term.c
+Michael Vehrs: changed woman.el
+
+Michael Welsh Duggan: changed nnimap.el lisp.h sh-script.el w32term.c
buffer.c gnus-spec.el keyboard.c nnir.el nnmail.el print.c
sieve-manage.el termhooks.h url-http.el w32-win.el w32fns.c w32menu.c
w32term.h woman.el xdisp.c xterm.c
-Michal Jankowski: changed insdel.c keyboard.c
+Michael Weylandt: changed ox-latex.el
+
+Michael Witten: changed TUTORIAL fixit.texi intro.texi
-Michal Nazarewicz: changed frame.c frame.h ispell.el w32term.c xterm.c
+Michal Jankowski: changed insdel.c keyboard.c
-Michal Sojka: changed org-icalendar.el
+Michal Nazarewicz: wrote descr-text-test.el tildify-tests.el
+and co-wrote tildify.el
+and changed simple.el remember.el bindings.el buffer.c cfengine.el cmds.c
+ descr-text.el eldoc.el files.el fill.el flyspell.el frame.c frame.h
+ hexl.el ielm.el ispell.el lisp/files.el mpc.el nxml-mode.el octave.el
+ paragraphs.el and 9 other files
-Michaël Cadilhac: changed browse-url.el gnus-sum.el gnus.texi ido.el
- emacsbug.el files.el fill.el flyspell.el fr-drdref.tex fr-refcard.ps
- fr-refcard.tex ispell.el meta-mode.el nnrss.el
- refcards/fr-dired-ref.pdf Makefile anti.texi battery.el blackbox.el
- bs.el calccard.pdf and 93 other files
+Michal Sojka: changed ox-icalendar.el
Michelangelo Grigni: wrote ffap.el
and changed gnus-score.el
rmailkwd.el rmailmsc.el rmailout.el rmailsum.el scribe.el server.el
sysdep.c unexcoff.c xmenu.c
+Miguel Ruiz: changed ob-gnuplot.el
+
+Mihir Rege: changed js.el
+
Mikael Djurfeldt: changed xdisp.c
Mikael Fornius: changed org.el org-habit.el
Mike Kazantsev: changed erc-dcc.el
-Mike Kupfer: changed mh-e.el mh-utils.el
+Mike Kupfer: changed mh-comp.el mh-e.el mh-utils.el
Mike Lamb: changed em-unix.el esh-util.el pcmpl-unix.el
Mike McEwan: changed gnus-agent.el gnus-sum.el gnus-score.el
+Mike McLean: changed org-agenda.el
+
Mike Newton: co-wrote bibtex.el
Mike Rowan: changed process.c alloc.c dispnew.c keyboard.c process.h
sysdep.c xdisp.c
+Mike Sperber: changed org.el org-footnote.el
+
Mike Williams: wrote mouse-sel.el thingatpt.el
and changed sgml-mode.el xml-lite.el
Mikio Nakajima: changed ring.el viper-util.el
Milan Zamazal: wrote glasses.el language/czech.el quail/czech.el
- tildify.el
-and co-wrote language/slovak.el prolog.el quail/slovak.el
-and changed abbrev.el filecache.el files.el mm-view.el org.el
- progmodes/compile.el
+and co-wrote language/slovak.el prolog.el quail/slovak.el tildify.el
+and changed czech.el abbrev.el filecache.el files.el mm-view.el org.el
+ progmodes/compile.el slovak.el
Miles Bader: wrote button.el face-remap.el image-file.el macroexp.el
mb-depth.el minibuf-eldef.el rfn-eshadow.el
and changed comint.el faces.el simple.el editfns.c xfaces.c xdisp.c
- info.el minibuf.c display.texi wid-edit.el xterm.c Makefile.in
- dispextern.h quick-install-emacs subr.el window.el cus-edit.el
- diff-mode.el xfns.c bytecomp.el help.el and 270 other files
+ info.el minibuf.c display.texi wid-edit.el xterm.c dispextern.h
+ quick-install-emacs subr.el window.el cus-edit.el diff-mode.el xfns.c
+ bytecomp.el help.el lisp.h and 273 other files
Milton Wulei: changed gdb-ui.el
+Mirek Kaim: changed configure.ac
+
Mirko Vukovic: changed emacs.texi maintaining.texi
+Mitchel Humpherys: changed vc-git.el
+
Miyashita Hisashi: changed ccl.c coding.c coding.h mule-cmds.el
mule-conf.el mule.el pop3.el
Miyoshi Masanori: changed mouse.el smtpmail.el xdisp.c
Mohsen Banan: wrote persian.el
+and changed loadup.el
-Mon Key: changed animate.el syntax.el
+Mon Key: changed animate.el imap.el syntax.el
Morten Welinder: wrote [many MS-DOS files] arc-mode.el desktop.el
dosfns.c internal.el msdos.h pc-win.el s-region.el
Motorola: changed buff-menu.el
+Muchenxuan Tong: changed org-agenda.el org-mobile.el org-timer.el
+
Murata Shuuichirou: changed coding.c
-N. Raghavendra: changed timezone.el
+Myles English: changed org-clock.el
Nachum Dershowitz: co-wrote cal-hebrew.el
Nagy Andras: co-wrote gnus-sieve.el
-and changed imap.el gnus.el
+and changed gnus.el
Nakagawa Makoto: changed ldap.el
-Nakaji Hiroyuki: changed mm-util.el amdx86-64.h configure.in smiley.el
+Nakaji Hiroyuki: changed mm-util.el amdx86-64.h configure.ac smiley.el
Nakamura Toshikazu: changed w32fns.c
-Nali Toja: changed configure.in
+Nali Toja: changed configure.ac
Naohiro Aota: changed fontset.c ftfont.c gnus-art.el mm-view.el tls.el
xftfont.c
+Nathaniel Flath: changed cc-menus.el cc-engine.el cc-fonts.el cc-langs.el
+ cc-mode.el cc-vars.el
+
Nathan J. Williams: changed imap.el
-Nathan Weizenbaum: changed js.el
+Nathan Trapuzzano: changed cconv.el cl-macs.el cperl-mode.el gnus.texi
+ linum.el progmodes/python.el python-tests.el
-Nathaniel Flath: changed cc-menus.el cc-engine.el cc-fonts.el cc-langs.el
- cc-mode.el cc-vars.el
+Nathan Weizenbaum: changed js.el progmodes/python.el
Neal Ziring: co-wrote vi.el (public domain)
Neil W. Van Dyke: wrote webjump.el
-Nelson H. F. Beebe: changed configure.in
+Nelson H. F. Beebe: changed configure.ac
-Nelson Jose dos Santos Ferreira: changed nnsoup.el gnus-art.el
- gnus-dup.el spam-stat.el
+Nelson Jose dos Santos Ferreira: changed nnsoup.el emacs.el gnus-art.el
+ gnus-dup.el gnus-win.el spam-stat.el
Nevin Kapur: changed nnmail.el gnus-sum.el nnimap.el gnus-group.el
gnus-registry.el gnus.el nnbabyl.el nnfolder.el nnmbox.el nnmh.el
nnml.el
+Nguyen Thai Ngoc Duy: co-wrote vnvni.el
+
Niall Mansfield: changed etags.c
-Nic Ferrier: changed tramp.el
+Nic Ferrier: changed ert.el tramp.el
Nicholas Maniscalco: changed term.el
Nick Alcock: changed gnus.el
-Nick Dokos: changed org-exp.el mh-search.el org.el url-cache.el
+Nick Dokos: changed org-table.el ox.el icalendar.el mh-search.el
+ org-mobile.el org.el ox-ascii.el url-cache.el
Nick Roberts: wrote gdb-mi.el t-mouse.el
and changed gdb-ui.el gud.el building.texi tooltip.el speedbar.el
bindings.el thumbs.el xt-mouse.el .gdbinit DEBUG cc-mode.el comint.el
keyboard.c subr.el frames.texi help-mode.el progmodes/compile.el
- xdisp.c Makefile.in display.texi term.c and 154 other files
+ xdisp.c display.texi term.c vc-svn.el and 144 other files
Nico Francois: changed w32fns.c w32inevt.c w32menu.c
Nicolas Avrutin: changed url-http.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 ob-exp.el org-clock.el org-macs.el
- org-mouse.el org.texi and 3 other files
+Nicolas Calderon Asselin: changed org-clock.el
+
+Nicolas Goaziou: wrote org-element.el org-macro.el ox-ascii.el
+ ox-latex.el ox-md.el ox-org.el ox.el
+and co-wrote ox-beamer.el ox-icalendar.el ox-man.el
+and changed org-list.el org.el ox-html.el org-footnote.el ox-texinfo.el
+ org.texi ox-publish.el ox-odt.el org-inlinetask.el org-indent.el
+ org-docbook.el ob-exp.el org-agenda.el org-timer.el ob.el
+ org-capture.el ob-asymptote.el org-clock.el org-macs.el
+ org-pcomplete.el org-table.el and 22 other files
+
+Nicolas Petton: wrote seq-tests.el seq.el
+and changed sequences.texi authors.el
+
+Nicolas Richard: changed org.el simple.el align.el battery.el byte-run.el
+ eieio-opt.el elisp-mode.el help.el isearch.el ispell.el minibuffer.el
+ ob.el package.el wid-edit.el
Niels Giesen: changed icalendar.el org-agenda.el org-clock.el
- org-docbook.el org-icalendar.el
+ org-docbook.el org-table.el ox-icalendar.el ox-latex.el
Niimi Satoshi: changed pp.el search.c
Niklas Morberg: changed nnweb.el gnus-art.el nnimap.el spam.el
+Nikolai Weibull: changed org.el
+
Nikolaj Schumacher: changed flymake.el progmodes/compile.el eldoc.el
elp.el nsfont.m rx.el
and co-wrote erc-dcc.el
and changed rsz-mini.el comint.el emacs-buffer.gdb files.el Makefile
mailabbrev.el sendmail.el subr.el timer.el yow.el apropos.el battery.el
- bytecomp.el calc.el coding.c complete.el config.in configure.in
- copyright.h fns.c gnu-linux.h and 19 other files
+ bytecomp.el calc.el coding.c complete.el configure.ac copyright.h fns.c
+ gnu-linux.h hpux7.h and 18 other files
Noah Lavine: changed tramp.el
+Noam Postavsky: changed cmdproxy.c process-tests.el w32proc.c
+
Nobuyoshi Nakada: co-wrote ruby-mode.el
Nobuyuki Hikichi: changed news-risc.h
Noel Cragg: changed mh-junk.el
-Noorul Islam: changed org-latex.el org-html.el org.el org.texi
+Noorul Islam: changed ox-latex.el org.el org.texi ox-html.el
org-capture.el org-gnus.el org-habit.el package.el
Norbert Koch: changed gnus-msg.el gnus-score.el
Nozomu Ando: changed unexmacosx.c alloc.c buffer.c mips.h pmax.h
smtpmail.el sysselect.h unexelf.c
+N. Raghavendra: changed timezone.el
+
Nuutti Kotivuori: changed gnus-sum.el flow-fill.el gnus-cache.el
Odd Gripenstam: wrote dcl-mode.el
-Ognyan Kulev: changed TUTORIAL.bg quail/cyrillic.el
+Ognyan Kulev: changed TUTORIAL.bg cyrillic.el
-Okazaki Tetsurou: changed cc-fonts.el
+Okazaki Tetsurou: changed cc-fonts.el vc-svn.el vc.el
Olaf Sylvester: wrote bs.el
Ole Aamot: changed compile.el
-Oleg S. Tihonov: changed ispell.el language/cyrillic.el map-ynp.el
- quail/cyrillic.el subr.el
+Oleg S. Tihonov: changed cyrillic.el ispell.el language/cyrillic.el
+ map-ynp.el subr.el
+
+Oleh Krehel: changed outline.el check-declare.el derived.el easy-mmode.el
+ gdb-mi.el lisp/custom.el org-capture.el org-clock.el replace.el
Oleksandr Gavenko: changed generic-x.el progmodes/grep.el
and changed gamegrid.el gnus-cite.el nonascii.texi rx.el startup.el
update-game-score.c
-Oliver Seidel: wrote todo-mode.el
+Oliver Seidel: wrote otodo-mode.el
+and co-wrote todo-mode.el
Olivier Laurens: changed forms.el
Osamu Yamane: changed smtpmail.el
-Oscar Figueiredo: wrote eudc-bob.el eudc-export.el eudc-hotlist.el
- eudc-vars.el eudc.el eudcb-bbdb.el eudcb-ldap.el eudcb-ph.el ldap.el
+Oscar Figueiredo: wrote ldap.el
+and co-wrote eudc-bob.el eudc-export.el eudc-hotlist.el eudc-vars.el
+ eudc.el eudcb-bbdb.el eudcb-ldap.el eudcb-ph.el
and changed ph.el
-Óscar Fuentes: changed ido.el cmdproxy.c emacsclient.c vc-bzr.el
+Oscar Fuentes: changed ms-w32.h CPP-DEFINES addpm.c addsection.c
+ browse-url.el configure.ac keyboard.c preprep.c vc-cvs.el vc-git.el
+ vc-hg.el vc-hooks.el vc-mtn.el vc-svn.el vc.el vc/vc-bzr.el w32.c
+ w32heap.c w32term.c
-P. E. Jareth Hein: changed gnus-util.el
+Óscar Fuentes: changed ido.el cmdproxy.c diff-mode.el emacsclient.c
+ vc-bzr.el
-Pascal Dupuis: changed octave-inf.el
+Pascal Dupuis: changed octave.el
Pascal Rigaux: changed image.c rfc2231.el
-Pat Thoyts: changed xfns.c
+Patrick Mahan: changed macfns.c
Patric Mueller: changed gnus-sum.el
-Patrick Mahan: changed macfns.c
+Pat Thoyts: changed xfns.c
Paul Curry: changed cc-subword.el
Paul D. Smith: wrote snmp-mode.el
and changed imenu.el make-mode.el
-Paul Eggert: wrote rcs2log vcdiff
+Paul Eggert: wrote rcs2log
and co-wrote cal-dst.el
-and changed lisp.h Makefile.in editfns.c alloc.c xdisp.c configure.in
- fileio.c image.c process.c fns.c xterm.c dispextern.h keyboard.c data.c
- lread.c sysdep.c xfns.c eval.c emacs.c buffer.c config.in
- and 573 other files
+and changed lisp.h configure.ac alloc.c process.c fileio.c sysdep.c
+ xdisp.c keyboard.c editfns.c image.c emacs.c xterm.c data.c lread.c
+ callproc.c fns.c Makefile.in dispextern.h dispnew.c eval.c xfns.c
+ and 1085 other files
Paul Fisher: changed fns.c
gnus-start.el gnus-sum.el nnmail.el
Paul Pogonyshev: changed progmodes/python.el subr.el which-func.el
- Makefile.in align.el byte-opt.el configure.in dabbrev.el display.texi
+ align.el byte-opt.el cc-langs.el configure.ac dabbrev.el display.texi
eldoc.el etags.el image-file.el image.c image.el info.el replace.el
- search.texi searching.texi ses.el tar-mode.el url-http.el window.el
+ search.texi searching.texi ses.el src/Makefile.in tar-mode.el
+ and 3 other files
-Paul Reilly: changed dgux.h lwlib-Xm.c lwlib.c xlwmenu.c configure.in
- mail-utils.el process.c rmail.el xfns.c Makefile.in dgux5-4R2.h
- dgux5-4R3.h files.el keyboard.c lwlib-Xaw.c lwlib-Xm.h lwlib-int.h
- lwlib.h mail/rmailmm.el rmailedit.el rmailkwd.el and 10 other files
+Paul Rankin: changed outline.el
+
+Paul Reilly: changed dgux.h lwlib-Xm.c lwlib.c xlwmenu.c configure.ac
+ mail-utils.el process.c rmail.el xfns.c dgux5-4R2.h dgux5-4R3.h
+ files.el keyboard.c lwlib-Xaw.c lwlib-Xm.h lwlib-int.h lwlib.h
+ lwlib/Makefile.in mail/rmailmm.el rmailedit.el rmailkwd.el
+ and 10 other files
Paul Rivier: changed ada-mode.el mixal-mode.el reftex-vars.el reftex.el
Paul Stodghill: changed gnus-agent.el gnus-util.el
-Pavel Janík: changed keyboard.c xterm.c COPYING xdisp.c Makefile.in
- process.c emacs.c lisp.h menu-bar.el ldap.el make-dist xfns.c buffer.c
- coding.c eval.c fileio.c flyspell.el fns.c indent.c callint.c
- cus-start.el and 710 other files
+Pavel Janík: co-wrote eudc-bob.el eudc-export.el eudc-hotlist.el
+ eudc-vars.el eudc.el eudcb-bbdb.el eudcb-ldap.el eudcb-ph.el
+and changed keyboard.c xterm.c COPYING xdisp.c process.c emacs.c lisp.h
+ menu-bar.el ldap.el make-dist xfns.c buffer.c coding.c eval.c fileio.c
+ flyspell.el fns.c indent.c Makefile.in callint.c cus-start.el
+ and 692 other files
Pavel Kobiakov: wrote flymake.el
and changed flymake.texi
-Peder O. Klingenberg: changed gnus.texi
+Peder O. Klingenberg: changed mm-decode.el emacsbug.el gnus.texi
+
+P. E. Jareth Hein: changed gnus-util.el
Per Abrahamsen: wrote cus-dep.el cus-edit.el cus-face.el cus-start.el
custom.el double.el gnus-cite.el gnus-cus.el progmodes/cpp.el
Per Persson: wrote gnus-vm.el
and co-wrote erc-dcc.el
-Per Starbäck: changed ispell.el dired.el gnus-start.el BUGS apropos.el
- bytecomp.el characters.el charset.h coding.c doctor.el emacs.c
+Per Starbäck: changed ispell.el characters.el dired.el gnus-start.el BUGS
+ apropos.el bibtex.el bytecomp.el charset.h coding.c doctor.el emacs.c
european.el iso-transl.el pcmpl-gnu.el replace.el startup.el
trouble.texi vc.el xdisp.c
-Pete Kazmier: changed gnus-art.el
+Pete Beardmore: changed semantic/complete.el idle.el
-Pete Ware: changed message.el
+Pete Kazmier: changed gnus-art.el
Peter Breton: wrote dirtrack.el emacs-lisp/generic.el filecache.el
find-lisp.el generic-x.el locate.el net-utils.el
Peter Heslin: changed flyspell.el outline.el
-Peter J. Weisberg: changed help.el picture.el simple.el
-
Peter Jolly: changed arc-mode.el ftfont.c
Peter Jones: changed nsterm.m
+Peter J. Weisberg: changed help.el picture.el simple.el
+
Peter Kleiweg: wrote ps-mode.el
Peter Liljenberg: wrote elint.el
-Peter Münster: changed gnus.texi org-agenda.el org.el
+Peter Münster: changed gnus-delay.el gnus-demon.el gnus-group.el
+ gnus-start.el gnus.texi org-agenda.el org.el
-Peter O'Gorman: changed configure.in frame.h hpux10-20.h termhooks.h
+Peter O'Gorman: changed configure.ac frame.h hpux10-20.h termhooks.h
-Peter Oliver: changed server.el
+Peter Oliver: changed perl-mode.el server.el
Peter Povinec: changed term.el
-Peter Runestig: changed makefile.w32-in configure.bat dos-w32.el emacs.rc
- envadd.bat gmake.defs multi-install-info.bat nmake.defs w32fns.c
- zone-mode.el
+Peter Rosin: changed configure.ac
+
+Peter Runestig: changed configure.bat dos-w32.el emacs.rc.in
+ emacs/makefile.w32-in envadd.bat gmake.defs lispintro/makefile.w32-in
+ lispref/makefile.w32-in misc/makefile.w32-in multi-install-info.bat
+ nmake.defs nt/makefile.w32-in src/makefile.w32-in w32fns.c zone-mode.el
+
+Peter Seibel: changed cl-indent.el lisp-mode.el
Peter S. Galbraith: wrote mh-alias.el mh-identity.el mh-inc.el
mh-limit.el
and changed mh-comp.el mh-e.el mh-utils.el mh-mime.el mh-customize.el
- mh-seq.el mh-init.el mh-search.el mh-xemacs-compat.el
- mh-xemacs-toolbar.el info-look.el mh-compat.el mh-funcs.el alias.pbm
- alias.xpm cabinet.xpm goto-addr.el highlight.xpm mh-junk.el
- mh-xemacs-icons.el mh-xemacs.el and 9 other files
-
-Peter Seibel: changed cl-indent.el lisp-mode.el
+ mh-seq.el Makefile mh-init.el mh-search.el mh-xemacs-compat.el
+ mh-xemacs-toolbar.el README info-look.el mh-compat.el mh-funcs.el
+ alias.pbm alias.xpm cabinet.xpm goto-addr.el highlight.xpm mh-junk.el
+ and 11 other files
Peter Stephenson: wrote vcursor.el
Peter Tury: changed org.texi
+Peter von der Ahe: changed gnus-ems.el
+
Peter Whaite: changed data.c
-Peter von der Ahe: changed gnus-ems.el
+Pete Ware: changed message.el
+
+Pete Williamson: changed leim/Makefile.in lib-src/Makefile.in
+ lisp/Makefile.in
-Petr Salinger: changed configure.in gnu-kfreebsd.h
+Petr Hracek: changed emacs.1
-Petri Kaurinkoski: changed configure.in iris4d.h irix6-0.h irix6-5.h
+Petri Kaurinkoski: changed configure.ac iris4d.h irix6-0.h irix6-5.h
usg5-4.h
+Petr Salinger: changed configure.ac gnu-kfreebsd.h
+
Phil Hagelberg: wrote ert-x-tests.el
and changed package.el pcmpl-unix.el subr.el
-Phil Sung: changed follow.el progmodes/python.el wdired.el
-
Philip Jackson: wrote find-cmd.el org-irc.el
-Philipp Haselwarter: changed gnus-agent.el gnus.texi
-
Philippe Schnoebelen: wrote gomoku.el mpuz.el
Philippe Waroquiers: changed etags.el term.c
-Pierre Poissinger: changed charset.c
+Philipp Haselwarter: changed gnus-agent.el gnus-sum.el gnus-sync.el
+ gnus.texi newcomment.el
-Piet van Oostrum: changed data.c fileio.c flyspell.el smtpmail.el
+Philipp Rumpf: changed electric.el
+
+Phil Sainty: changed lisp.el subword.el
+
+Phil Sung: changed follow.el progmodes/python.el wdired.el
+
+Pierre Poissinger: changed charset.c
Pieter E.J. Pareit: wrote mixal-mode.el
Pieter Schoenmakers: changed TUTORIAL.nl
+Piet van Oostrum: changed data.c fileio.c flyspell.el smtpmail.el
+
Pinku Surana: changed sql.el
-Piotr Zielinski: wrote org-mouse.el
+Piotr Zieliński: wrote org-mouse.el
Prestoo Ten: changed screen.el
Primoz Peterlin: changed TUTORIAL.sl
-Puneeth Chaganti: changed org.texi org-exp.el org-agenda.el
- org-capture.el org-html.el
-
-R. Bernstein: changed gud.el
+Puneeth Chaganti: changed org.texi ox.el org-agenda.el org-capture.el
+ ox-html.el
-Rafael Laboissiere: changed org.el org.texi
+Rafael Laboissiere: changed org-remember.el org-bibtex.el org.el org.texi
Rafael Sepúlveda: changed TUTORIAL.es
Raffael Mancini: changed misc.el
-Rainer Orth: changed Makefile.in
-
-Rainer Schoepf: wrote alpha.h unexalpha.c
-and changed osf1.h alloc.c buffer.c callint.c data.c dispextern.h doc.c
- editfns.c floatfns.c frame.h lisp.h lread.c marker.c mem-limits.h
- print.c puresize.h window.h xdisp.c xterm.h
+Rainer Orth: changed gtkutil.c lisp/Makefile.in
-Raja R. Harinath: changed gnus-salt.el nnml.el
+Rainer Schöpf: changed osf1.h unexalpha.c alloc.c alpha.h buffer.c
+ callint.c data.c dispextern.h doc.c editfns.c floatfns.c frame.h lisp.h
+ lread.c marker.c mem-limits.h print.c puresize.h window.h xdisp.c
+ xterm.h
Rajappa Iyer: changed gnus-salt.el
+Raja R. Harinath: changed gnus-salt.el nnml.el
+
Rajesh Vaidheeswarran: wrote old-whitespace.el
and changed whitespace.el ffap.el
Ralf Angeli: wrote scroll-lock.el
-and changed w32fns.c gnus-art.el reftex-cite.el reftex-toc.el reftex.el
+and changed w32fns.c reftex-cite.el gnus-art.el reftex-toc.el reftex.el
+ reftex-auc.el reftex-dcr.el reftex-global.el reftex-index.el
+ reftex-parse.el reftex-ref.el reftex-sel.el reftex-vars.el reftex.texi
tex-mode.el comint.el flow-fill.el frame.el killing.texi mm-uu.el
- mm-view.el package.el pcl-cvs.texi reftex-auc.el reftex-dcr.el
- reftex-global.el reftex-index.el reftex-parse.el reftex-ref.el
- reftex-sel.el and 6 other files
+ mm-view.el and 6 other files
Ralf Fassel: changed dabbrev.el files.el fill.el iso-acc.el tar-mode.el
+Ralf Mattes: changed el.srt
+
Ralph Schleicher: wrote battery.el info-look.el
and changed libc.el browse-url.el fileio.c info.el mm-decode.el
- nnultimate.el perl-mode.el which-func.el
+ perl-mode.el which-func.el
Ramakrishnan M: changed mlm-util.el
+Randall Smith: changed dired.el
+
Randal Schwartz: wrote pp.el
-Randall Smith: changed dired.el
+Ransom Williams: changed files.el
+
+Rasmus Pank: changed org.el ox-latex.el ob-C.el org-entities.el
+ org-src.el ox.el
+
+Rasmus Pank Roulund: changed ange-ftp.el gnus-fun.el
+ gnus-notifications.el vc-git.el
Raul Acevedo: changed info.el options.el
-Ray Blaak: co-wrote delphi.el
+Ray Blaak: co-wrote opascal.el
Raymond Scholz: co-wrote deuglify.el
and changed gnus-art.el gnus-msg.el gnus.texi message.el nnmail.el
pgg-gpg.el
+R. Bernstein: changed gud.el
+
Reiner Steib: wrote gmm-utils.el gnus-news.el
and changed message.el gnus.texi gnus-art.el gnus-sum.el gnus-group.el
gnus.el mml.el gnus-faq.texi mm-util.el gnus-score.el message.texi
gnus-msg.el gnus-start.el gnus-util.el spam-report.el mm-uu.el spam.el
- mm-decode.el files.el gnus-agent.el nnmail.el and 182 other files
+ mm-decode.el files.el gnus-agent.el nnmail.el and 173 other files
Remek Trzaska: changed gnus-ems.el
Remi Letot: changed nnmaildir.el
+Rémi Vanicat: changed ox-icalendar.el org-table.el
+
Renaud Rioboo: changed nnmail.el
-René Kyllingstad: changed pcomplete.el
+René Kyllingstad: changed editfns.c mule-cmds.el pcomplete.el
Reto Zimmermann: wrote vera-mode.el
and co-wrote vhdl-mode.el
+and changed vhdl-mode.texi
-Reuben Thomas: changed files.el flymake.el loading.texi pcvs-defs.el
- simple.el
+Reuben Thomas: changed remember.el README files.el msdos.c INSTALL
+ ada-mode.el ada-xref.el alloc.c arc-mode.el authors.el config.bat
+ copyright dired.el dosfns.c ediff.texi editfns.c emacs-xtra.texi
+ emacs.texi emacs/Makefile.in emacs/makefile.w32-in flymake.el
+ and 22 other files
Riccardo Murri: changed vc-bzr.el tls.el
-Richard Dawe: changed Makefile.in config.in
+Richard Copley: changed Makefile.in epaths.in epaths.nt gdb-mi.el
+
+Richard Dawe: changed src/Makefile.in
Richard G. Bielawski: changed modes.texi paren.el
Richard Hoskins: changed message.el
Richard Kim: wrote wisent/python.el
-and changed loading.texi python-wy.el texnfo-upd.el
+and changed bovine.texi db-global.el loading.texi texnfo-upd.el
+ wisent.texi
Richard King: wrote filelock.c uniquify.el userlock.el
-Richard L. Pieri: wrote pop3.el
-
-Richard Lawrence: changed org-latex.el
+Richard Lawrence: changed org-agenda.el ox-latex.el
Richard Levitte: changed vc-mtn.el
-Richard M. Heiberger: changed tex-mode.el
+Richard L. Pieri: wrote pop3.el
-Richard M. Stallman: wrote [The original GNU Emacs and numerous files]
- easymenu.el image-mode.el menu-bar.el paren.el
-and co-wrote cc-align.el cc-cmds.el cc-defs.el cc-engine.el cc-langs.el
- cc-menus.el cc-mode.el cc-styles.el cc-vars.el font-lock.el
-and changed files.el keyboard.c simple.el xterm.c xdisp.c rmail.el
- Makefile.in fileio.c process.c sysdep.c buffer.c xfns.c window.c
- configure.in subr.el startup.el sendmail.el emacs.c editfns.c info.el
- dispnew.c and 1350 other files
+Richard M. Heiberger: changed tex-mode.el
Richard Mlynarik: wrote cl-indent.el ebuff-menu.el ehelp.el rfc822.el
terminal.el yow.el
-and changed files.el simple.el rmail.el info.el sysdep.c bytecomp.el
+and changed files.el rmail.el simple.el info.el sysdep.c bytecomp.el
startup.el keyboard.c fileio.c process.c sendmail.el window.c editfns.c
unexec.c xfns.c keymap.c lisp-mode.el minibuf.c buffer.c dired.el
dispnew.c and 140 other files
+Richard M. Stallman: wrote [The original GNU Emacs and numerous files]
+ easymenu.el image-mode.el menu-bar.el paren.el
+and co-wrote cc-align.el cc-cmds.el cc-defs.el cc-engine.el cc-langs.el
+ cc-menus.el cc-mode.el cc-styles.el cc-vars.el font-lock.el
+and changed files.el keyboard.c simple.el xterm.c xdisp.c rmail.el
+ fileio.c process.c sysdep.c buffer.c xfns.c window.c subr.el
+ configure.ac startup.el sendmail.el emacs.c Makefile.in editfns.c
+ info.el dired.el and 1335 other files
+
Richard Sharman: wrote hilit-chg.el
and changed sh-script.el ediff-init.el regexp-opt.el simple.el
Rick Farnbach: wrote morse.el
+Rick Frankel: changed ox-html.el ob-sql.el org.texi
+
Rick Sladkey: wrote backquote.el
and changed gud.el intervals.c intervals.h simple.el
-Rob Browning: changed configure.in
+Rob Browning: changed configure.ac
Rob Christie: changed nsmenu.m
-Rob Giardina: changed org-agenda.el
-
-Rob Kaut: changed vhdl-mode.el
-
-Rob Riepel: wrote tpu-edt.el tpu-extras.el tpu-mapper.el vt-control.el
-and changed tpu-doc.el
-
Robert Bihlmeyer: changed gnus-score.el gnus-util.el message.el
Robert Brown: changed lisp-mode.el
Robert Fenk: changed desktop.el
+Robert Jarzmik: changed ede/linux.el inversion.el
+
Robert J. Chassell: wrote makeinfo.el page-ext.el texinfo.el
texnfo-upd.el
-and changed texinfmt.el emacs-lisp-intro.texi emacs.tex texinfo.tex
- info.el texinfo-update.el INSTALL case-table.el cl.texinfo help-fns.el
+and changed texinfmt.el emacs-lisp-intro.texi emacs.texi texinfo.tex
+ info.el texinfo-update.el INSTALL case-table.el cl.texi help-fns.el
help-mode.el history.el informat.el latin-1.el latin-2.el latin-3.el
- latin-4.el page.el tex-mode.el texinfo.texinfo vip.texinfo
+ latin-4.el page.el tex-mode.el texinfo.texi vip.texi
Robert Marshall: changed mule-cmds.el
-Robert P. Goldman: changed org.texi ob-exp.el org-latex.el org.el
+Roberto Huelga Díaz: changed org-clock.el org-timer.el
+
+Roberto Rodríguez: changed ada-mode.texi glossary.texi widget.texi
+
+Robert P. Goldman: changed org.texi ob-exp.el org.el ox-latex.el
-Robert Pluim: changed gnus-demon.el org-agenda.el
+Robert Pluim: changed configure.ac gnus-demon.el org-agenda.el
+ todo-mode.el
Robert Thorpe: changed cus-start.el indent.el
-Roberto Huelga: changed org-clock.el
+Rob Giardina: changed org-agenda.el
-Roberto Rodríguez: changed ada-mode.texi glossary.texi widget.texi
+Rob Kaut: changed vhdl-mode.el
+
+Rob Riepel: wrote tpu-edt.doc tpu-edt.el tpu-extras.el tpu-mapper.el
+ vt-control.el
Roderick Schertler: changed dgux.h dgux4.h gud.el sysdep.c
Rodney J. Whitby: co-wrote vhdl-mode.el
-Rodrigo Real: changed pt-br-refcard.tex pt-br-refcard.ps
+Rodrigo Real: changed pt-br-refcard.tex
+
+Rod Whitby: changed vhdl-mode.texi
Roger Breitenstein: changed smtpmail.el
Roland B. Roberts: changed buffer.h callproc.c dired.c files.el
gnus-group.el gnus-sum.el process.c sort.el sysdep.c systty.h
-Roland Kaufmann: changed org-exp.el
+Roland Kaufmann: changed ox.el
Roland McGrath: wrote autoload.el etags.el map-ynp.el progmodes/grep.el
and co-wrote find-dired.el progmodes/compile.el
-and changed compile.el add-log.el configure.in files.el Makefile.in vc.el
- simple.el mailabbrev.el comint.el buffer.c upd-copyr.el etags.c
- menu-bar.el mem-limits.h ralloc.c fileio.c data.c process.c rlogin.el
- rmail.el shell.el and 137 other files
+and changed compile.el add-log.el configure.ac files.el vc.el simple.el
+ mailabbrev.el comint.el Makefile.in buffer.c upd-copyr.el menu-bar.el
+ etags.c mem-limits.h ralloc.c src/Makefile.in fileio.c data.c process.c
+ rlogin.el rmail.el and 139 other files
Roland Winkler: wrote proced.el
-and changed bibtex.el process.c appt.el artist.el conf-mode.el
- flyspell.el hideshow.el ibuffer.el ispell.el make-mode.el sgml-mode.el
- sh-script.el skeleton.el smtpmail.el
+and changed bibtex.el faces.el crm.el process.c appt.el artist.el
+ conf-mode.el cus-edit.el diary-lib.el flyspell.el hideshow.el
+ ibuf-ext.el ibuffer.el ispell.el make-mode.el sgml-mode.el sh-script.el
+ skeleton.el smtpmail.el
Rolf Ebert: co-wrote ada-mode.el ada-stmt.el ada-xref.el
and changed files.el find-file.el
-Romain Francoise: changed faq.texi message.el Makefile.in make-dist
- gnus.texi dired-x.el comint.el ibuf-ext.el subr.el gnus-sum.el
- gnus-uu.el progmodes/compile.el puresize.h replace.el startup.el
- configure.in doclicense.texi emacs.c files.texi gnus-fun.el help-fns.el
- and 146 other files
+Romain Francoise: changed efaq.texi message.el make-dist gnus.texi
+ dired-x.el Makefile.in comint.el fileio.c ibuf-ext.el subr.el
+ configure.ac files.texi gnus-sum.el gnus-uu.el progmodes/compile.el
+ puresize.h replace.el startup.el doclicense.texi emacs.c gnus-fun.el
+ and 150 other files
Roman Belenov: changed which-func.el
-Ron Schnell: wrote dunnet.el
-
Ronan Waide: changed smtpmail.el
+Ron Schnell: wrote dunnet.el
+
Ross Patterson: co-wrote org-protocol.el
+Roy Hashimoto: changed mm-view.el
+
Roy Liu: changed ns-win.el
+Rüdiger Sonderfeld: wrote inotify-test.el reftex-tests.el
+and changed eww.el octave.el shr.el bibtex.el configure.ac
+ misc/Makefile.in reftex-vars.el vc-git.el TUTORIAL.de ada-mode.el
+ autoinsert.el building.texi calc-lang.el cc-langs.el dired.texi
+ editfns.c emacs.c emacs.texi epa.el erc.el eww.texi and 35 other files
+
Rui-Tao Dong: changed nnweb.el
Rune Kleveland: changed xfns.c
-Rupert Swarbrick: changed gnus-score.el
+Rupert Swarbrick: changed autoinsert.el cal-html.el gnus-score.el
Russ Allbery: changed message.el
Ryan Barrett: changed dirtrack.el
+Ryan Crum: changed json.el
+
Ryan C. Thompson: changed savehist.el
Ryan Twitchell: changed ido.el
and changed ffap.el ispell.el message.texi rmailsum.el simple.el
testcover.el webjump.el
+Ryo Takaishi: changed ob-tangle.el org-capture.el org-protocol.el
+
Ryo Yoshitake: changed xterm.c frame.c frame.h mac.c macfns.c w32fns.c
xfns.c
Ryszard Kubiak: co-wrote ogonek.el
-Rémi Vanicat: changed org-icalendar.el
-
Sacha Chua: wrote erc-pcomplete.el
-and changed erc.el erc-button.el
+and changed erc.el org.el erc-button.el org.texi
Saito Takuya: changed mule.el progmodes/compile.el
Sam Dooley: changed keyboard.c
+Samer Masterson: changed em-hist.el em-pred.el pcomplete.el
+
Sam Falkner: changed nntp.el
Sam Kendall: changed etags.c etags.el
Sam Steingold: wrote gulp.el midnight.el
and changed progmodes/compile.el cl-indent.el vc-cvs.el vc.el mouse.el
- simple.el font-lock.el ange-ftp.el vc-hg.el window.el add-log.el
- bookmark.el bug-reference.el diary-lib.el dired.el etags.el pcvs.el
- tex-mode.el apropos.el bindings.el emacs-lisp/debug.el
- and 126 other files
+ simple.el files.el font-lock.el tex-mode.el vc-hg.el ange-ftp.el
+ sgml-mode.el window.el add-log.el bindings.el bookmark.el
+ bug-reference.el calendar.el cperl-mode.el diary-lib.el dired.el
+ and 149 other files
+
+Samuel Bronson: changed custom.el emacsclient.c keyboard.c
+ progmodes/grep.el unexmacosx.c
-Samuel Bronson: changed custom.el
+Samuel Loury: changed org.el
Samuel Tardieu: changed smime.el
Sanghyuk Suh: changed mac-win.el macterm.c
+Santiago Payà i Miralta: changed vc-hg.el
+
Sascha Lüdecke: co-wrote mml1991.el
and changed gnus-win.el
-Sascha Wilde: changed pgg-gpg.el pgg.texi pgg.el bubbles.el configure.in
+Sascha Wilde: changed pgg-gpg.el pgg.texi pgg.el bubbles.el configure.ac
ede/srecode.el proj-shared.el vc-hg.el
Satyaki Das: wrote mh-acros.el mh-gnus.el mh-search.el mh-speed.el
mh-thread.el mh-tool-bar.el
and co-wrote mh-junk.el
and changed mh-e.el mh-utils.el mh-seq.el mh-comp.el mh-mime.el
- mh-customize.el mh-funcs.el mh-alias.el mh-unit.el mh-init.el
+ mh-customize.el mh-funcs.el Makefile mh-alias.el mh-unit.el mh-init.el
mh-identity.el mh-make.el mh-xemacs-toolbar.el mh-xemacs-compat.el
- pgg-gpg.el mh-inc.el highlight.xpm mh-func.el mh-logo.xpm mh-print.el
- mh-xemacs.el simple.el
+ pgg-gpg.el mh-inc.el highlight.xpm mh-logo.xpm mh-print.el mh-xemacs.el
+ simple.el
Schlumberger Technology Corporation: changed gud.el
Scott M. Meyers: changed cmacexp.el
+Sean Connor: changed gnus-sum.el
+
Sean Neakums: changed gnus-msg.el gnus-uu.el supercite.el
Sean O'Halpin: changed ob.el
and changed add-log.el
Sebastian Rose: co-wrote org-protocol.el
-and changed org-publish.el ftfont.c org-jsinfo.el
+and changed ox-publish.el ftfont.c ox-jsinfo.el
Sebastian Tennant: changed desktop.el
+Sebastian Wiesner: changed bytecomp.el comint.el files.el replace.el
+ simple.el
+
+Sébastien Delafond: changed org.el
+
+Sébastien Gross: changed hideshow.el
+
Sebastien Kirche: changed mail-extr.el
-Seiji Zenitani: changed nsfns.m frame.c xterm.c Info.plist PkgInfo
- document.icns find-func.el frame.h help-fns.el macfns.c nsfont.m
- nsterm.m w32fns.c xdisp.c xfns.c
+Sébastien Vauban: changed org.el org-agenda.el ox-latex.el ob-core.el
+ org-clock.el ox-ascii.el ox-html.el
+
+Seiji Zenitani: changed nsfns.m frame.c xterm.c PkgInfo document.icns
+ find-func.el frame.h help-fns.el macfns.c nsfont.m nsterm.m w32fns.c
+ xdisp.c xfns.c
Sen Nagata: wrote crm.el rfc2368.el
Sergei Organov: changed vc.el
Sergey Litvinov: co-wrote ob-fortran.el
+and changed ob-maxima.el ob-octave.el
Sergey Poznyakoff: changed mh-mime.el rmail.el rmail.texi smtpmail.el
+Sergio Durigan Junior: changed eudcb-bbdb.el gdb-mi.el
+
+Sergio Martinez: changed nnimap.el
+
Sergio Pokrovskij: changed TUTORIAL.eo
Seweryn Kokot: changed positions.texi searching.texi
Shawn Boles: changed url-cookie.el
-Shawn M. Carey: wrote freebsd.h
+Shawn M. Carey: wrote [some early FreeBSD support]
Shenghuo Zhu: wrote binhex.el mm-extern.el mm-partial.el mm-url.el
mm-uu.el mml2015.el nnrss.el rfc1843.el uudecode.el
and co-wrote gnus-dired.el nnfolder.el
and changed gnus-art.el message.el gnus-sum.el gnus-msg.el gnus.el
gnus-agent.el mm-decode.el mm-util.el gnus-group.el mml.el
- gnus-start.el gnus-util.el mm-view.el nnslashdot.el nnmail.el nntp.el
- gnus-topic.el gnus-xmas.el rfc2047.el mail-source.el gnus-win.el
- and 97 other files
+ gnus-start.el gnus-util.el mm-view.el nnmail.el nntp.el gnus-topic.el
+ gnus-xmas.el rfc2047.el mail-source.el gnus-win.el nnheader.el
+ and 87 other files
Shigeru Fukaya: wrote bytecomp-tests.el
-and changed byte-opt.el bytecomp-testsuite.el bytecomp.el elint.el
- rx-new.el ses.el texinfmt.el
+and changed apropos.el byte-opt.el bytecomp.el elint.el rx-new.el ses.el
+ texinfmt.el
Shinichirou Sugou: changed etags.c
-Sho Nakatani: changed doc-view.el
-
Shoji Nishimura: changed org.el
+Sho Nakatani: changed doc-view.el
+
Shuhei Kobayashi: wrote hex-util.el hmac-def.el hmac-md5.el
and changed gnus-group.el message.el nnmail.el
Sigbjorn Finne: changed gnus-srvr.el
+Simen Heggestøyl: changed css-mode.el scheme.el
+
Simon Josefsson: wrote dig.el dns-mode.el flow-fill.el fringe.el imap.el
- mml-sec.el mml-smime.el password-cache.el rfc2104.el sieve-manage.el
- sieve-mode.el sieve.el smime.el starttls.el tls.el url-imap.el
+ mml-sec.el mml-smime.el password-cache.el rfc2104.el sieve-mode.el
+ sieve.el smime.el starttls.el tls.el url-imap.el
and co-wrote gnus-sieve.el gssapi.el mml1991.el nnfolder.el nnimap.el
- nnml.el
+ nnml.el sieve-manage.el
and changed message.el gnus-sum.el gnus-art.el smtpmail.el pgg-gpg.el
pgg.el gnus-agent.el mml2015.el mml.el gnus-group.el mm-decode.el
gnus-msg.el gnus.texi pgg-pgp5.el browse-url.el gnus-int.el gnus.el
- hashcash.el mm-view.el password.el gnus-cache.el and 99 other files
+ hashcash.el mm-view.el password.el gnus-cache.el and 98 other files
+
+Simon Law: changed delsel.el electric.el
Simon Leinen: changed Makefile.in smtpmail.el Makefile cm.c cm.h hpux9.h
- indent.c process.c sc.texinfo sgml-mode.el term.c vc.el xfns.c xmenu.c
- xterm.c
+ indent.c leim/Makefile.in process.c sc.texi sgml-mode.el term.c vc.el
+ xfns.c xmenu.c xterm.c
Simon Marshall: wrote fast-lock.el lazy-lock.el regexp-opt.el
and co-wrote comint.el shell.el
menu-bar.el perl-mode.el ps-print.el rmailsum.el bytecomp.el
cc-fonts.el data.c faces.el lisp-mode.el and 56 other files
-Simon South: co-wrote delphi.el
+Simon Schubert: changed json.el
+
+Simon South: co-wrote opascal.el
+
+Simon Thum: changed ob-maxima.el
Skip Collins: changed w32fns.c w32term.c w32term.h
Stefan Merten: co-wrote rst.el
-Stefan Monnier: wrote bibtex-style.el bzrmerge.el css-mode.el
- cvs-status.el diff-mode.el lexbind-tests.el log-edit.el log-view.el
- minibuffer.el mpc.el pcase.el pcvs-defs.el pcvs-info.el pcvs-parse.el
- pcvs-util.el reveal.el smerge-mode.el smie.el vc-mtn.el
-and co-wrote font-lock.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 1033 other files
+Stefan Monnier: wrote bibtex-style.el bzrmerge.el cl-generic-tests.el
+ cl-generic.el cl-preloaded.el cl.el completion-tests.el
+ core-elisp-tests.el css-mode.el cvs-status.el diff-mode.el gv.el
+ inline.el lexbind-tests.el log-edit.el log-view.el minibuffer.el mpc.el
+ nadvice.el pcase.el pcvs-defs.el pcvs-info.el pcvs-parse.el
+ pcvs-util.el regexp-tests.el reveal.el smerge-mode.el smie.el
+ subword-tests.el vc-mtn.el
+and co-wrote font-lock.el gitmerge.el
+and changed subr.el simple.el keyboard.c lisp.h bytecomp.el files.el
+ vc.el cl-macs.el xdisp.c alloc.c eval.c progmodes/compile.el keymap.c
+ sh-script.el pcvs.el newcomment.el buffer.c tex-mode.el window.c
+ vc-hooks.el lread.c and 1245 other files
+
+Stefano Facchini: changed gtkutil.c
Stefan Reichör: changed gnus-agent.el
Stefan Waldherr: changed nnweb.el
-Stefan Wiens: changed gnus-sum.el
+Stefan-W. Hahn: changed org-bibtex.el ps-print.el simple.el
-Steinar Bang: changed imap.el
+Stefan Wiens: changed gnus-sum.el
Štěpán Němec: changed INSTALL calc-ext.el cl.texi comint.el edebug.texi
font-lock.el loading.texi maps.texi mark.texi message.texi mini.texi
Stephen A. Wood: changed fortran.el
-Stephen Berman: changed diary-lib.el todo-mode.el allout.el dframe.el
- dired-aux.el dired.el files.el find-dired.el frame.c gnus-group.el
- gtkutil.c info.el minibuffer.el newcomment.el page.el proced.el
- recentf.el rfc822.el subr.el
+Stephen Berman: co-wrote todo-mode.el
+and changed todo-mode.texi diary-lib.el minibuffer.el info.el
+ otodo-mode.el allout.el dframe.el dired-aux.el dired.el doc-view.el
+ elpa files.el find-dired.el frame.c gamegrid.el gnus-group.el gomoku.el
+ gtkutil.c misc/Makefile.in newcomment.el outline.el and 8 other files
-Stephen C. Gilardi: changed configure.in
+Stephen C. Gilardi: changed configure.ac
Stephen Compall: changed saveplace.el texinfo.el
Stephen Eglen: wrote iswitchb.el mspools.el
-and changed diary-lib.el locate.el octave-inf.el org-agenda.el replace.el
+and changed diary-lib.el octave.el org-agenda.el locate.el replace.el
hexl.el info-look.el sendmail.el spell.el uce.el MORE.STUFF add-log.el
advice.el allout.el autoinsert.el avoid.el backquote.el battery.el
- bib-mode.el bruce.el c-mode.el and 78 other files
+ bib-mode.el bruce.el c-mode.el and 80 other files
Stephen Gildea: wrote refcard.tex
and co-wrote mh-funcs.el mh-search.el
Stephen J. Turnbull: changed ediff-init.el strings.texi subr.el
-Stephen Leake: changed ada-mode.el ada-xref.el ada-mode.texi ada-prj.el
- ada-stmt.el align.el pcvs-parse.el vhdl-mode.el
+Stephen Leake: changed ada-mode.el ada-xref.el CONTRIBUTE ada-mode.texi
+ ada-prj.el ada-stmt.el INSTALL.REPO align.el commits pcvs-parse.el repo
+ startup.el trouble.texi vhdl-mode.el
Stephen Peters: changed icalendar.el
Steve Grubb: changed vcdiff
-Steve Nygard: changed unexnext.c
-
-Steve Purcell: changed nnimap.el
-
-Steve Strassmann: wrote spook.el
-
-Steve Youngs: changed mh-utils.el mh-xemacs-compat.el mh-customize.el
- mh-e.el mh-comp.el mh-mime.el dns.el gnus-art.el browse-url.el
- gnus-sum.el gnus-xmas.el mh-search.el mh-seq.el password.el
- run-at-time.el em-unix.el gmm-utils.el gnus-cite.el gnus-demon.el
- gnus-ems.el gnus-msg.el and 16 other files
-
Steven E. Harris: changed nnheader.el
Steven Huwig: changed emacs.py progmodes/python.el
-Steven L. Baur: wrote footnote.el gnus-setup.el
+Steven L. Baur: wrote footnote.el
and changed gnus-xmas.el gnus-msg.el add-log.el edebug.el gnus-ems.el
gnus-start.el gnus-topic.el message.el nnbabyl.el nntp.el webjump.el
Steven Suhr: changed dispnew.c scroll.c term.c termchar.h
-Steven Tamm: changed macterm.c mac.c macfns.c configure.in mac-win.el
- unexmacosx.c Makefile.in darwin.h editfns.c lread.c macmenu.c
- scroll-bar.el config.h config.in dispnew.c eval.c fileio.c fns.c
+Steven Tamm: changed macterm.c mac.c macfns.c configure.ac mac-win.el
+ unexmacosx.c darwin.h editfns.c lread.c macmenu.c scroll-bar.el
+ src/Makefile.in Makefile.in config.h dispnew.c eval.c fileio.c fns.c
generic-x.el image.c process.c and 3 other files
+Steve Nygard: changed unexnext.c
+
+Steve Purcell: changed nnimap.el nsterm.m package.el
+
+Steve Strassmann: wrote spook.el
+
+Steve Youngs: changed mh-utils.el mh-xemacs-compat.el mh-customize.el
+ mh-e.el mh-comp.el mh-mime.el Makefile dns.el gnus-art.el browse-url.el
+ gnus-sum.el gnus-xmas.el mh-search.el mh-seq.el password.el
+ run-at-time.el em-unix.el gmm-utils.el gnus-cite.el gnus-demon.el
+ gnus-ems.el and 17 other files
+
Stewart M. Clamen: co-wrote cal-mayan.el cc-align.el cc-cmds.el
cc-defs.el cc-engine.el cc-langs.el cc-menus.el cc-mode.el cc-styles.el
cc-vars.el
allout.el comint.el edebug.el find-lisp.el keymap.c minibuf.c sregex.el
timeclock.el widget.texi
+Stuart Hickinbottom: changed org-clock.el
+
Sudish Joseph: changed mac-win.el
+Suhail Shergill: changed ob-core.el ox-html.el
+
+Sundar Narasimhan: changed rnews.el
+
Sun Microsystems, Inc: wrote emacs.icon sun.el
and changed emacsclient.c server.el
Sun Yijiang: changed TUTORIAL.cn
-Sundar Narasimhan: changed rnews.el
+Suvayu Ali: changed org.texi org-inlinetask.el org-src.el org.el ox.el
-Suvayu Ali: changed org.texi org-exp.el org-inlinetask.el org-src.el
+Svend Tollak Munkejord: changed deuglify.el
Sven Joachim: changed files.el de-refcard.tex dired-aux.el emacs.1
arc-mode.el dired-x.el em-cmpl.el em-hist.el em-ls.el esh-cmd.el
esh-ext.el esh-io.el files.texi gnus-news.texi gnus-sum.el gnus.texi
help.el make-dist message.el movemail.c mule.texi and 8 other files
-Svend Tollak Munkejord: changed deuglify.el
+Sylvain Chouleur: changed gnus-icalendar.el icalendar.el
Syver Enstad: changed gud.el
-Sébastien Delafond: changed org.el
-
-Sébastien Vauban: changed org.el org-agenda.el org-html.el org-latex.el
-
-T.V. Raman: changed completion.el files.el json.el mairix.el mspools.el
- xml.c
-
Taichi Kawabata: wrote quail/indian.el ucs-normalize.el
-and changed devanagari.el ind-util.el Makefile.in devan-util.el
- language/indian.el characters.el fontset.el malayalam.el mlm-util.el
- mule-conf.el tamil.el tml-util.el
+and changed indian.el devanagari.el ind-util.el devan-util.el
+ language/indian.el characters.el fontset.el leim/Makefile.in
+ lisp/Makefile.in malayalam.el mlm-util.el mule-conf.el tamil.el
+ tml-util.el
Takaaki Ota: wrote textmodes/table.el
and changed appt.el dired.c etags.c ldap.el makefile.w32-in
progmodes/compile.el recentf.el replace.el subr.el w32bdf.c
+Takafumi Arakaki: changed url-expand.el url-http.el which-func.el
+
Takahashi Kaoru: changed texinfmt.el
Takahashi Naoto: wrote ethio-util.el language/ethiopic.el latin-post.el
quail/cyrillic.el quail/ethiopic.el robin.el
and co-wrote latin-ltx.el quail.el
-and changed fontset.el mule-conf.el
+and changed ethiopic.el fontset.el mule-conf.el
Takai Kousuke: changed ccl.el compface.el
Tassilo Horn: wrote doc-view.el
and co-wrote org-gnus.el
-and changed subword.el image-mode.el Makefile.in cc-cmds.el emacsbug.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 26 other files
+and changed reftex-vars.el gnus.texi gnus-sum.el tsdh-dark-theme.el
+ misc.texi reftex.el subword.el tsdh-light-theme.el image-mode.el
+ cc-cmds.el display.texi em-term.el emacsbug.el files.el gnus-art.el
+ nnimap.el reftex-cite.el reftex-ref.el buffers.texi control.texi
+ help.texi and 63 other files
Tatsuya Ichikawa: changed gnus-agent.el gnus-cache.el
Ted Lemon: changed emacs.c lastfile.c puresize.h
-Ted Phelps: changed mh-search.el mh-tool-bar.el
+Ted Phelps: changed mh-search.el mh-e.el mh-folder.el mh-junk.el
+ mh-scan.el mh-tool-bar.el shr.el
-Teemu Likonen: changed dired.el gnus-agent.el message.el
+Ted Wiles: changed org-habit.el
+
+Teemu Likonen: changed dired.el erc-backend.el gnus-agent.el indent.el
+ message.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 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
+ url-future.el url-util-tests.el
+and changed spam.el gnus.el nnimap.el gnus.texi gnus-sum.el gnutls.c
+ auth.texi cfengine.el gnus-util.el gnus-start.el netrc.el message.el
+ spam-stat.el encrypt.el gnutls.h nnir.el nnmail.el imap.el
+ mail-source.el nnmairix.el nntp.el and 110 other files
Terje Rosten: changed xfns.c version.el xterm.c xterm.h
Tetsuo Tsukamoto: changed nnrss.el
-Tetsurou Okazaki: changed Makefile.in byte-opt.el log-edit.el lread.c
- xterm.c
+Tetsurou Okazaki: changed Makefile.in byte-opt.el lib-src/Makefile.in
+ log-edit.el lread.c xterm.c
+
+T.F. Torrey: changed org-rmail.el ox.el
Thamer Mahmoud: changed arabic.el
Theodore Jump: changed makefile.nt makefile.def w32-win.el w32faces.c
Thien-Thi Nguyen: co-wrote hideshow.el
-and changed ewoc.el vc.el info.el zone.el Makefile.in processes.texi
- lisp-mode.el text.texi vc-rcs.el display.texi fileio.c files.el
- scheme.el vc-git.el MORE.STUFF TUTORIAL.it bindat.el cc-vars.el
- configure.in dcl-mode.el diff-mode.el and 158 other files
+and changed ewoc.el vc.el info.el zone.el processes.texi lisp-mode.el
+ scheme.el text.texi vc-rcs.el display.texi fileio.c files.el vc-git.el
+ MORE.STUFF TUTORIAL.it bindat.el cc-vars.el configure.ac dcl-mode.el
+ diff-mode.el dired.el and 159 other files
+
+Thierry Banel: changed calc-arith.el
Thierry Emery: changed kinsoku.el timezone.el url-http.el wid-edit.el
Thierry Volpiatto: changed bookmark.el files.el dired-aux.el
- eshell/eshell.el gnus-sum.el files.texi image-mode.el info.el man.el
- woman.el dired.el doc-view.el find-func.el gnus-art.el gnus-msg.el
- image-dired.el tramp.el vc-rcs.el
+ eshell/eshell.el gnus-sum.el net-utils.el package.el tramp.el eldoc.el
+ files.texi image-mode.el info.el man.el woman.el avoid.el dired.el
+ doc-view.el find-func.el font-lock.el gnus-art.el gnus-msg.el
+ and 6 other files
+
+Thomas Bach: changed wisent/python.el
Thomas Baumann: wrote org-mhe.el
and co-wrote org-bbdb.el
Thomas Bellman: co-wrote avl-tree.el
-Thomas Deweese: changed x-win.el
+Thomas DeWeese: changed x-win.el
Thomas Dorner: changed ange-ftp.el
Thomas Dye: changed org.texi org-bibtex.el ob-R.el org.el
+Thomas Fitzsimmons: changed ldap.el eudc-vars.el eudc.el eudcb-ldap.el
+ eudc.texi ntlm.el
+
Thomas Horsley: changed cxux-crt0.s cxux.h cxux7.h emacs.c nh3000.h
nh4000.h simple.el sysdep.c xterm.c
Thomas Hühn: changed tutorial.el
+Thomas Kappler: changed nsfont.m
+
Thomas Link: wrote filesets.el
Thomas Morgan: changed org-habit.el forms.el select.el
Tijs van Bakel: changed erc.el
+Tim Burt: changed org-datetree.el
+
Tim Cross: changed keymaps.texi
Tim Harper: changed ns-win.el
-Tim Landscheidt: changed gnus.texi icalendar.el sort.el ws-mode.el
+Tim Howe: changed org-clock.el
-Tim Van Holder: changed emacsclient.c Makefile.in configure.in
- progmodes/compile.el which-func.el
+Tim Landscheidt: changed gnus.texi icalendar.el sort.el ws-mode.el
Timo Juhani Lindfors: changed gnus-msg.el
+Timo Lilja: changed mail-source.el
+
+Timo Myyrä: changed battery.el
+
Timo Savola: changed emacs.c gtkutil.c startup.el x-win.el xfns.c xterm.c
xterm.h
+Tim Van Holder: changed emacsclient.c Makefile.in configure.ac
+ progmodes/compile.el which-func.el
+
Tobias C. Rittweiler: changed font-lock.el searching.texi sendmail.el
Tobias Ringström: changed etags.c
Toby Allsopp: changed ldap.el eudc.el
Toby Cubitt: co-wrote avl-tree.el
-
-Toby S. Cubitt: changed org.el
+and changed org-capture.el org.el org-agenda.el org-clock.el
+ org-colview.el org.texi
Toby Speight: changed generic-x.el window.el
-Tokuya Kameshima: wrote org-mew.el
-and co-wrote org-wl.el
-
-Tom Breton: changed autoinsert.el cus-edit.el gnus-agent.el lread.c
+Toke Høiland-Jørgensen: changed gnutls.c nnmaildir.el smime.el
-Tom Hageman: changed etags.c
+Tokuya Kameshima: changed org-mew.el org-agenda.el
-Tom Houlder: wrote mantemp.el
+Tomas Abrahamsson: wrote artist.el
-Tom Perrine: co-wrote modula2.el (public domain)
+Tomasz Gajewski: changed cpp-root.el
-Tom Rauchenwald: changed spam.el
+Tom Breton: changed autoinsert.el cus-edit.el gnus-agent.el lread.c
-Tom Tromey: wrote bug-reference.el erc-list.el package-x.el package.el
-and co-wrote tcl.el
-and changed buffer.c lisp.h makefile.el window.c xfns.c callint.c cmds.c
- configure.in frame.c keyboard.c keymap.c xdisp.c buffer.h bytecode.c
- callproc.c category.c character.c character.h charset.c coding.c
- composite.c and 133 other files
+Tom Hageman: changed etags.c
-Tomas Abrahamsson: wrote artist.el
+Tom Houlder: wrote mantemp.el
Tommi Vainikainen: changed gnus-sum.el message.el mml-sec.el
gnus-ems.el gnus-mule.el message.el nnspool.el nntp.el rmailkwd.el
smiley.el
+Tomohiro Matsuyama: wrote profiler.el
+and changed profiler.c alloc.c emacs.c eval.c lisp.h src/Makefile.in
+ src/makefile.w32-in xdisp.c
+
Tomoji Kagatani: wrote smtpmail.el
+Tom Perrine: co-wrote modula2.el (public domain)
+
+Tom Rauchenwald: changed spam.el
+
+Tom Regner: changed notifications.el
+
+Tom Seddon: changed w32font.c
+
+Tom Tromey: wrote bug-reference.el erc-list.el package-x.el
+and co-wrote package.el tcl.el
+and changed buffer.c lisp.h makefile.el window.c keyboard.c keymap.c
+ xfns.c buffer.h bytecode.c callint.c callproc.c cmds.c composite.c
+ configure.ac dispextern.h doc.c editfns.c fileio.c frame.c insdel.c
+ intervals.h and 137 other files
+
+Tom Willemse: changed package.el prog-mode.el progmodes/python.el
+ simple.el
+
Torbjörn Axelsson: changed options.el
Torbjörn Einarsson: wrote progmodes/f90.el
and changed f90.el
-Torsten Anders: changed org-beamer.el
+Torsten Anders: changed ox-beamer.el
Torsten Bronger: changed latin-ltx.el
Toru Tomabechi: wrote language/tibetan.el quail/tibetan.el tibet-util.el
Toru Tsuneyoshi: changed ange-ftp.el buff-menu.el cus-start.el fileio.c
- files.el lisp.h tramp.el w32fns.c
+ files.el fill.el lisp.h tramp.el w32fns.c
Toshiaki Nomura: changed uxpds.h
-Travis Jeffery: changed Info.plist
-
Trent W. Buck: changed rcirc.el remember.el rx.el
+Trevor Murphy: changed gnus.texi nnimap.el org.el
+
Trey Jackson: changed spam-stat.el
Triet Hoai Lai: changed vntelex.el viet-util.el vietnamese.el
-Troels Nielsen: changed process.c
+Troels Nielsen: changed process.c buffer.c progmodes/compile.el window.el
Trung Tran-Duc: changed nntp.el
gnus-cache.el gnus-msg.el gnus.el nndiary.el nnfolder.el nnimap.el
nnmaildir.el pgg.el rfc2047.el
-Tsugutomo Enami: changed frame.c keyboard.c configure.in dispnew.c
+Tsugutomo Enami: changed frame.c keyboard.c configure.ac dispnew.c
fileio.c process.c simple.el sysdep.c xdisp.c add-log.el bytecomp.el
- editfns.c emacs.c frame.h gnus-group.el netbsd.h nnheader.el
- perl-mode.el regex.c regex.h rmailsum.el and 4 other files
+ editfns.c emacs.c frame.h gnus-group.el netbsd.h nnheader.el nnimap.el
+ perl-mode.el regex.c regex.h and 6 other files
Tsuyoshi Akiho: changed gnus-sum.el nnrss.el
Tudor Hulubei: changed iso-acc.el latin-pre.el
+T.V. Raman: changed completion.el files.el json.el mairix.el mspools.el
+ xml.c
+
Uday S Reddy: changed etags.el fill.el
Ulf Jasper: wrote bubbles.el icalendar-tests.el icalendar.el
- newst-backend.el newst-plainview.el newst-reader.el newst-ticker.el
- newst-treeview.el newsticker-tests.el newsticker.el
-and changed icalendar-testsuite.el calendar.texi newsticker-plainview.el
- newsticker-treeview.el newsticker.texi newsticker-backend.el
- newsticker-reader.el newsticker-ticker.el Makefile.in README
+ libxml-tests.el newst-backend.el newst-plainview.el newst-reader.el
+ newst-ticker.el newst-treeview.el newsticker-tests.el newsticker.el
+and changed newsticker.texi calendar.texi image.c newsticker-plainview.el
+ newsticker-treeview.el README newsticker-backend.el
+ newsticker-reader.el newsticker-ticker.el xml.c Makefile.in
browse-url.xpm get-all.xpm mark-immortal.xpm mark-read.xpm narrow.xpm
- newsticker newsticker-testsuite.el next-feed.xpm next-item.xpm
- prev-feed.xpm prev-item.xpm and 3 other files
+ newsticker next-feed.xpm next-item.xpm prev-feed.xpm prev-item.xpm
+ and 8 other files
Ulf Stegemann: co-wrote org-entities.el
and changed org-gnus.el smime.el
Ulrich Leodolter: changed w32proc.c
-Ulrich Mueller: changed configure.in Makefile.in doctor.el files.el
- gud.el server.el ChgPane.c ChgSel.c HELLO INSTALL XMakeAssoc.c
- authors.el bytecomp.el calc-units.el case-table.el configure em-ls.el
- emacs.1 emacs.c emacs.desktop emacsclient.c and 26 other files
+Ulrich Müller: changed configure.ac lib-src/Makefile.in src/Makefile.in
+ version.el doctor.el emacs.1 files.el gamegrid.el gud.el server.el
+ ChgPane.c ChgSel.c HELLO INSTALL Makefile.in XMakeAssoc.c authors.el
+ bytecomp.el calc-units.el case-table.el configure and 39 other files
Ulrich Neumerkel: changed xterm.c
Ulrik Vieth: wrote meta-mode.el
and changed files.el
+Uwe Brauer: changed mml-smime.el
+
Vadim Nasardinov: changed allout.el
Vagn Johansen: changed gnus-cache.el vc-svn.el
Valentin Wüstholz: changed org.el
-Valery Alexeev: changed cyril-util.el quail/cyrillic.el
+Valery Alexeev: changed cyril-util.el cyrillic.el
-Vasily Korytov: changed message.el quail/cyrillic.el cperl-mode.el
- gnus-art.el gnus-dired.el gnus-msg.el gnus-util.el mail-source.el
- smiley.el
+Vasily Korytov: changed cyrillic.el message.el cperl-mode.el gnus-art.el
+ gnus-dired.el gnus-msg.el gnus-util.el mail-source.el smiley.el
-Victor Zandy: wrote zone.el
+Vegard Øye: changed viper-init.el
-Vida Gábor: changed gnus-demon.el
+Victor Zandy: wrote zone.el
-Viktor Rosenfeld: changed ob-sql.el
+Viktor Rosenfeld: changed ob-sql.el org.el
Ville Skyttä: changed mh-comp.el pgg.el tcl.el
Vincent Belaïche: changed ses.el 5x5.el calc-alg.el calc-vec.el calc.texi
- calc-embed.el calc-help.el calc-misc.el calc.el floatfns.c org.el
- recentf.el
+ ses.texi calc-embed.el calc-help.el calc-misc.el calc.el configure.bat
+ floatfns.c macroexp.el org.el package.el recentf.el reftex-parse.el
+ reftex-toc.el reftex.el
+
+Vincent Bernat: changed gnus-int.el nnimap.el
Vincent Del Vecchio: changed info.el mh-utils.el
and changed ps-prin1.ps ps-bdf.el ps-prin0.ps blank-mode.el ps-prin3.ps
ps-prin2.ps lpr.el subr.el diff-mode.el TUTORIAL.pt_BR compilation.txt
easymenu.el loading.texi menu-bar.el misc.texi progmodes/compile.el
- ps-print-def.el ps-print.ps ps-vars.el
+ ps-print-def.el ps-vars.el
-Vitalie Spinu: changed ob-R.el
+Vitalie Spinu: changed comint.el message.el ob-R.el ob-core.el
+ ob-tangle.el subr.el
Vivek Dasmohapatra: wrote hfy-cmap.el htmlfontify.el
-and changed erc.el erc-backend.el emacs.c erc-join.el erc-services.el
- sh-script.el xterm.c xterm.h
+and changed erc.el erc-backend.el erc-services.el hexl.el emacs.c
+ erc-join.el htmlfontify.texi sh-script.el xterm.c xterm.h
Vladimir Alexiev: changed arc-mode.el nnvirtual.el tmm.el
+Vladimir Kazanov: changed java.srt
+
+Vladimir Lomov: changed ox-html.el
+
Vladimir Volovich: changed smime.el
Volker Sobek: changed programs.texi
-W. Martin Borgert: changed files.el schemas.xml
-
Walter C. Pelissero: changed browse-url.el url-methods.el
Wang Diancheng: changed gdb-mi.el nnml.el
+Wei-Wei Guo: co-wrote rst.el
+
Werner Benger: changed keyboard.c
Werner Lemberg: wrote sisheng.el vntelex.el
-and changed Makefile.in TUTORIAL.de calc.texi chinese.el emacs.1
- european.el idlwave.el language/czech.el language/slovak.el
+and co-wrote vnvni.el
+and changed TUTORIAL.de calc.texi chinese.el emacs.1 european.el
+ idlwave.el language/czech.el language/slovak.el lispref/Makefile.in
reftex-vars.el reftex.el reftex.texi supercite.el advice.el
calc-forms.el calc-sel.el calendar.el china-util.el cl-macs.el cl.texi
- complete.el and 50 other files
+ complete.el and 53 other files
Werner Meisner: changed lwlib-Xm.c
Wes Hardaker: changed gnus-score.el gnus-art.el gnus-sum.el gnus-win.el
spam.el
+Wesley Dawson: changed icomplete.el
+
Wilfred Hughes: changed vc-git.el
Will Glozer: changed macterm.c
-Will Mengarini: wrote repeat.el
-
William F. Schelter: wrote telnet.el
William M. Perry: wrote url-dav.el url-gw.el url-http.el url-util.el
url.el vc-dav.el
and co-wrote mailcap.el socks.el
and changed url-handlers.el url-file.el url-methods.el url-vars.el
- url-https.el aclocal.m4 mule-sysdp.el url-imap.el url-news.el
- url-nfs.el image.el mwheel.el url-about.el url-auth.el url-cid.el
- url-dired.el url-expand.el url-ftp.el url-history.el url-irc.el
- url-misc.el and 5 other files
+ url-https.el url-imap.el url-news.el url-nfs.el image.el mwheel.el
+ url-about.el url-auth.el url-cid.el url-dired.el url-expand.el
+ url-ftp.el url-history.el url-irc.el url-misc.el url-parse.el
+ url-privacy.el and 3 other files
+
+William Parsons: changed ange-ftp.el
William Smith: changed strftime.c
William Sommerfeld: wrote emacsclient.c scribe.el server.el
William Stevenson: wrote adwaita-theme.el
+and changed artist.el
-William Xu: changed nsterm.m outline.el webjump.el
+William Xu: changed arc-mode.el gcc.el hideif.el nsterm.m outline.el
+ url.el webjump.el
+
+Will Mengarini: wrote repeat.el
Wilson H. Tien: changed unexelf.c
Wim Nieuwenhuizen: changed TUTORIAL.nl
Wlodzimierz Bzyl: co-wrote ogonek.el
-and changed latin-pre.el pl-refcard.ps pl-refcard.tex refcard-pl.ps
- refcard-pl.tex survival.tex
+and changed latin-pre.el pl-refcard.tex survival.tex
+
+W. Martin Borgert: changed files.el schemas.xml
Wolfgang Glas: changed unexsgi.c
-Wolfgang Jenkner: changed conf-mode.el gnus-agent.el gnus-sum.el lread.c
- network-stream.el pcvs.el pop3.el
+Wolfgang Jenkner: wrote man-tests.el
+and changed gnus-agent.el image-mode.el man.el network-stream.el
+ ansi-color.el gnus-spec.el gnus-sum.el gnus-util.el
+ automated/Makefile.in calc-tests.el calc-units.el conf-mode.el
+ functions.texi gnus-group.el gnus-picon.el gnus-salt.el gnus-start.el
+ gnus.texi intro.texi lread.c nntp.el and 7 other files
Wolfgang Lux: changed nsterm.m keyboard.c
Wolfgang Rupprecht: wrote float-sup.el floatfns.c sup-mouse.el
-and changed config.in process.c alloc.c callint.c configure.in data.c
- ecrt0.c fns.c lisp-mode.el lisp.h loadup.el lread.c net-utils.el
- nntp.el print.c sort.el
+and changed process.c alloc.c callint.c configure.ac data.c fns.c
+ lisp-mode.el lisp.h loadup.el lread.c net-utils.el nntp.el print.c
+ sort.el
Wolfgang Scherer: changed vc-cvs.el
Wolfram Gloger: changed emacs.c
+W. Trevor King: changed xterm.el
+
Xavier Maillard: changed gnus-faq.texi gnus-score.el mh-utils.el spam.el
+Xue Fuqiao: changed display.texi maintaining.texi files.texi
+ nonascii.texi text.texi windows.texi os.texi vc-cvs.el vc-dir.el
+ emacs.texi ido.texi vc-git.el vc-hg.el vc-hooks.el vc-svn.el vc.el
+ vc/vc-bzr.el INSTALL cl.texi emacs-lisp-intro.texi frames.texi
+ and 91 other files
+
Yagi Tatsuya: changed gnus-art.el gnus-start.el
-Yair F: changed quail/hebrew.el
+Yair F: changed hebrew.el
-Yamamoto Mitsuharu: changed macterm.c macfns.c mac-win.el mac.c macterm.h
- macmenu.c macgui.h image.c xdisp.c macselect.c keyboard.c xterm.c
- Makefile.in emacs.c darwin.h dispnew.c unexmacosx.c w32term.c alloc.c
- dispextern.h configure.in and 88 other files
+Yamamoto Mitsuharu: wrote uvs.el
+and changed macterm.c macfns.c mac-win.el mac.c macterm.h macmenu.c
+ macgui.h image.c xdisp.c xterm.c macselect.c keyboard.c w32term.c
+ src/Makefile.in unexmacosx.c emacs.c darwin.h dispnew.c configure.ac
+ dispextern.h alloc.c and 89 other files
Yann Dirson: changed imenu.el
-Yann Hodique: changed rcirc.el
+Yann Hodique: changed ox-publish.el package.el rcirc.el
+
+Yasushi Shoji: changed org-clock.el org.texi ox-ascii.el
+
+Yavor Doganov: changed configure.ac Makefile.in emacs.1 etags.1 make-dist
+ nsfont.m
-Yavor Doganov: changed configure.in Info-gnustep.plist Makefile.in
- emacs.1 etags.1 make-dist nsfont.m
+Ye Qianchuan: changed descr-text.el
Yoichi Nakayama: changed browse-url.el finder.el man.el rfc2368.el
Yong Lu: changed charset.c coding.c language/greek.el
Yoni Rabkin: changed faces.el net-utils.el artist.el bs.el cmacexp.el
- ediff.el files.el hilit19.el ps-mode.el simula.el vera-mode.el
+ ediff.el eww.el files.el hilit19.el ps-mode.el simula.el vera-mode.el
verilog-mode.el vhdl-mode.el viper.el whitespace.el
Yoshiaki Kasahara: changed buffer.c term.c
Yoshiki Hayashi: changed texinfmt.el nnheader.el
+Yoshinari Nomura: changed ox-html.el ox.el
+
Yoshinori Koseki: wrote iimage.el
and changed fontset.el message.el nnheader.el nnmail.el
-Yu-Ji Hosokawa: changed README.W32
-
Yuanle Song: changed rng-xsd.el
+Yu-ji Hosokawa: changed README.W32
+
Yukihiro Matsumoto: co-wrote ruby-mode.el
Yuri Karaban: changed pop3.el
Yuri Shtil: changed etags.c
-Yutaka Niibe: changed indent.c xdisp.c configure.in Makefile.in dispnew.c
- 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
+Yuriy Vostrikov: changed vc-git.el
+
+Yutaka Niibe: changed indent.c xdisp.c configure.ac dispnew.c sysdep.c
+ Makefile.in dired.el emacs.c fill.el fns.c gmalloc.c gnu-linux.h
+ indent.h process.c simple.el src/Makefile.in term.c window.c
-Zachary Kanfer: changed cus-edit.el keyboard.c
+Yuya Nishihara: changed vc-hooks.el
+
+Yves Baumes: changed package.el
+
+Zachary Kanfer: changed org.el 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
- rfc2047.el x-win.el
+ faces.el fontset.el lib-src/makefile.w32-in mm-util.el mule.el
+ org-publish.el rfc2047.el x-win.el
Zhang Weize: wrote ob-plantuml.el
+Zhongwei Yao: changed tramp-adb.el
+
Zoltan Kemenczy: changed gud.el
Zoran Milojevic: changed avoid.el
-Йордан Миладинов: changed quail/cyrillic.el
+Дядов Васил Стоянов: changed org-docview.el
+
+Йордан Миладинов: changed cyrillic.el
Local Variables:
coding: utf-8
+2015-03-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * TODO: Remove obsolete entries.
+
+2015-03-24 Daniel Colascione <dancol@dancol.org>
+
+ * NEWS: Mention change to `process-running-child-p`.
+
+2015-03-23 Daiki Ueno <ueno@gnu.org>
+
+ * NEWS: Mention `make-process'.
+
+2015-03-21 Titus von der Malsburg <malsburg@posteo.de>
+
+ * NEWS: Mention `default-font-width', `window-font-height',
+ `window-font-width', and `window-max-chars-per-line'.
+
+2015-03-03 Kelvin White <kwhite@gnu.org>
+
+ * NEWS.24: Add section to include ERC changes.
+
+2015-03-02 Daniel Colascione <dancol@dancol.org>
+
+ * NEWS: Mention finalizers.
+
+2015-02-09 Gareth Rees <gdr@garethrees.org> (tiny change)
+
+ * NEWS.24: Fix typo (bug#19820)
+
+2015-02-08 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * NEWS: Document `comment-line'.
+
+2015-02-03 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * NEWS: Document package.el's improved dependency-handling.
+
2015-01-29 Francesc Rocher <francesc.rocher@gmail.com>
* images/splash.svg, images/splash.png:
\f
* New features
+** nnimap can request and use the Gmail "X-GM-LABELS".
+
** New package `gnus-notifications.el' can send notifications when you
receive new messages.
group instead of a user if its argument is prefixed by ':' (a colon).
This will cause the game score files in ${localstatedir}/games/emacs
to be owned by that group, and the helper program for updating them to
-be installed setgid.
+be installed setgid. The option now defaults to the 'games' group.
---
** The `grep-changelog' script (and its manual page) are no longer included.
\f
* Changes in Emacs 25.1
-** Xwidgets : A new feature for embedding native widgets
-inside Emacs buffers. If you have gtk3 and webkit-devel installed,
-you can try the embedded webkit browser with m-x xwidget-webkit-browse-url.
-** `package-install-from-buffer' and `package-install-file' work on directories.
-This follows the same rules as installing from a .tar file, except the
--pkg file is optional.
+
+** New command `comment-line' bound to `C-x C-;'.
** New function `custom-prompt-customize-unsaved-options' checks for
unsaved customizations and prompts user to customize (if found).
In particular, it now returns the average width of the font's
characters, which can be used for geometry-related calculations.
+** A new function `default-font-width' returns the average width of a
+character in the current buffer's default font. If the default face
+is remapped (see `face-remapping-alist'), the value for the remapped
+face is returned. This function complements the existing function
+`default-font-height'.
+
+** New functions `window-font-height' and `window-font-width' return
+the height and average width of characters in a specified face and
+window. If FACE is remapped (see `face-remapping-alist'), the
+function returns the information for the remapped face.
+
+** A new function `window-max-chars-per-line' returns the maximal
+number of characters that can be displayed on one line. If a face
+and/or window are provided, these values are used for the
+calculation. This function is different from `window-body-width' in
+that it accounts for (i) continuation glyphs, (ii) the size of the
+font, and (iii) the specified window.
+
\f
* Editing Changes in Emacs 25.1
** You can access `mouse-buffer-menu' (C-down-mouse-1) using C-f10.
++++
+** New buffer-local `electric-pair-local-mode'.
+
\f
* Changes in Specialized Modes and Packages in Emacs 25.1
+** xterm-mouse-mode now supports mouse-tracking (if your xterm supports it).
+
+** package.el
+*** `package-install-from-buffer' and `package-install-file' work on directories.
+This follows the same rules as installing from a .tar file, except the
+-pkg file is optional.
+
+*** Packages which are dependencies of other packages cannot be deleted.
+The FORCE argument to `package-delete' overrides this.
+
+*** New custom variable `package-selected-packages' tracks packages
+which were installed by the user (as opposed to installed as
+dependencies). This variable can also be manually customized.
+
+*** New command `package-install-user-selected-packages' installs all
+packages from `package-selected-packages' which are currently missing.
+
+*** New command `package-autoremove' removes all packages which were
+installed strictly as dependencies but are no longer needed.
+
** Shell
When you invoke `shell' interactively, the *shell* buffer will now
*** The <class> variables are declared obsolete.
*** The <initarg> variables are declared obsolete.
*** defgeneric and defmethod are declared obsolete.
+*** `constructor' is now an obsolete alias for `make-instance'.
** ido
*** New command `ido-bury-buffer-at-head' bound to C-S-b
** eww
+---
+*** HTML can now be rendered using variable-width fonts.
+
++++
+*** A new command `F' (`eww-toggle-fonts') can be used to toggle
+whether to use variable-pitch fonts or not. The user can also
+customize the `shr-use-fonts' variable.
+
+++
*** A new command `R' (`eww-readable') will try do identify the main
textual parts of a web page and display only that, leaving menus and
transformed into multipart/related messages before sending.
** pcase
-*** New UPatterns `quote' and `app'.
+*** New UPatterns `quote', `app', `cl-struct', and `eieio'.
*** New UPatterns can be defined with `pcase-defmacro'.
+++
*** New vector QPattern.
** New ERT function `ert-summarize-tests-batch-and-exit'.
+** New js.el option `js-indent-first-init'.
+
---
** `Info-fontify-maximum-menu-size' can be t for no limit.
*** Two new faces `compare-windows-removed' and `compare-windows-added'
replace the obsolete face `compare-windows'.
+** VHDL mode supports VHDL'08.
+
** Calculator: decimal display mode uses "," groups, so it's more
fitting for use in money calculations; factorial works with
non-integer inputs.
allow overriding the regular expression that recognizes the ldapsearch
command line's password prompt.
+** Eshell
+
+*** The new built-in command `clear' can scroll window contents out of sight.
+
+** Browse-url
+
+*** Support for the Conkeror web browser.
+
+---
+*** Support for several ancient browsers is now officially obsolete.
+
+++
** tar-mode: new `tar-new-entry' command, allowing for new members to
be added to the archive.
+** Autorevert: dired buffers are also auto-reverted via file
+notifications, if Emacs is compiled with file notification support.
+
** Obsolete packages
---
\f
* Incompatible Lisp Changes in Emacs 25.1
+** `save-excursion' does not save&restore the mark any more.
+
+** read-buffer-function can now be called with a 4th argument (`predicate').
+
** completion-table-dynamic stays in the minibuffer.
If you want the old behavior of calling the function in the buffer
from which the minibuffer was entered, call it with the new argument
** `cl-the' now asserts that its argument is of the given type.
+** `process-running-child-p` may now return a numeric process
+group ID instead of `t'.
+
+++
** Mouse click events on mode line or header line no longer include
any reference to a buffer position. The 6th member of the mouse
denied" instead of "permission denied". The old behavior was problematic
in languages like German where downcasing rules depend on grammar.
++++
+** The character classes [:alpha:] and [:alnum:] in regular expressions
+now match multibyte characters using Unicode character properties.
+If you want the old behavior where they matched any character with
+word syntax, use `\sw' instead.
+
\f
* Lisp Changes in Emacs 25.1
+** New function `make-process' provides an alternative interface to
+`start-process'. It allows programs to set process parameters such as
+process filter, sentinel, etc., through keyword arguments (similar to
+`make-network-process').
+
+** `read-buffer' takes a new `predicate' argument.
+
+** Emacs Lisp now supports generators.
+
+** New finalizer facility for running code when objects
+ become unreachable.
+
+** lexical closures can use (:documentation <form>) to build their docstring.
+It should be placed right where the docstring would be, and <form> is then
+evaluated (and should return a string) when the closure is built.
+
** define-inline provides a new way to define inlinable functions.
** New function macroexpand-1 to perform a single step of macroexpansion.
or Windows Server 2003. The built binaries still run on all versions
of Windows starting with Windows 9X.
++++
+** Emacs running on MS-Windows now supports the daemon mode.
+
** OS X 10.5 or older is no longer supported.
** OS X on PowerPC is no longer supported.
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 all necessary documentation updates are complete.
- (This means all relevant manuals in doc/ AND lisp doc-strings.)
---- means no change in the manuals is needed.
-When you add a new item, use the appropriate mark if you are sure it applies,
-otherwise leave it unmarked.
-
\f
* Changes in Emacs 24.5
----
+** This is mainly a bug-fix release, but there are some other changes.
+
** The default value of `history-length' has increased to 100.
-+++
-** `redisplay-dont-pause' is declared as obsolete.
+** The variable `redisplay-dont-pause' is obsolete.
\f
* Changes in Specialized Modes and Packages in Emacs 24.5
-** `call-process-shell-command' and `process-file-shell-command'
-don't take "&rest args" any more.
+** `call-process-shell-command' and `process-file-shell-command' no longer
+take "&rest args".
+
+** The option `browse-url-firefox-startup-arguments' no longer has an effect.
+
+** ERC
+
+*** New option `erc-rename-buffers'.
+
+*** New faces `erc-my-nick-prefix-face' and `erc-nick-prefix-face'.
+
+*** `erc-format-@nick' displays all user modes instead of only op and voice.
+
+*** The display of irc commands in the current buffer has been disabled.
+
+*** `erc-version' now follows the Emacs version.
** Obsolete packages
*** cc-compat.el
----
-*** crisp.el - moved to elpa.gnu.org.
+*** crisp.el (moved to elpa.gnu.org)
----
*** tpu-edt.el, ws-mode.el
These emulations of old editors are believed to be no longer relevant
- contact emacs-devel@gnu.org if you disagree.
----
*** vi.el, vip.el (try M-x viper instead)
\f
*** New variable `completion-extra-properties' used to specify extra
properties of the current completion:
-- :annotate-function, same as the old completion-annotate-function.
+- :annotation-function, same as the old completion-annotate-function.
- :exit-function, function to call after completion took place.
*** Functions on `completion-at-point-functions' can return any of the
Known Problems with GNU Emacs
-Copyright (C) 1987-1989, 1993-1999, 2001-2015 Free Software Foundation,
-Inc.
+Copyright (C) 1987-1989, 1993-1999, 2001-2015 Free Software Foundation, Inc.
See the end of the file for license conditions.
endif
endif
+*** Emacs startup on GNU/Linux systems (and possibly other systems) is slow.
+
+This can happen if the system is misconfigured and Emacs can't get the
+full qualified domain name, FQDN. You should have your FQDN in the
+/etc/hosts file, something like this:
+
+127.0.0.1 localhost
+129.187.137.82 nuc04.t30.physik.tu-muenchen.de nuc04
+
+The way to set this up may vary on non-GNU systems.
+
+*** Visiting files in some auto-mounted directories causes Emacs to print
+`Error reading dir-locals: (file-error "Read error" "is a directory" ...'
+
+This can happen if the auto-mounter mistakenly reports that
+.dir-locals.el exists and is a directory. There is nothing Emacs can
+do about this, but you can avoid the issue by adding a suitable entry
+to the variable `locate-dominating-stop-dir-regexp'. For example, if
+the problem relates to "/smb/.dir-locals.el", set that variable
+to a new value where you replace "net\\|afs" with "net\\|afs\\|smb".
+(The default value already matches common auto-mount prefixes.)
+See http://lists.gnu.org/archive/html/help-gnu-emacs/2015-02/msg00461.html .
+
*** Attempting to visit remote files via ange-ftp fails.
If the error message is "ange-ftp-file-modtime: Specified time is not
"FOO-tab -> ?\FOO-\t", "uppercase -> lowercase", "[fringe KEY...] ->
[KEY]", "H-FOO -> M-FOO", "C-x C-y FOO -> H-FOO", ...
+* Things related to elpa.gnu.org.
+
+** Move idlwave to elpa.gnu.org.
+Need to sync up the Emacs and external versions.
+See <http://lists.gnu.org/archive/html/emacs-devel/2014-07/msg00008.html>
+
+** Move Org mode to elpa.gnu.org.
+See <http://lists.gnu.org/archive/html/emacs-devel/2014-08/msg00300.html>
+<http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg00257.html>
+
+** Move verilog-mode to elpa.gnu.org.
+See <http://lists.gnu.org/archive/html/emacs-devel/2015-02/msg01180.html>
+
+** Move vhdl-mode to elpa.gnu.org.
+See <http://lists.gnu.org/archive/html/emacs-devel/2015-02/msg01180.html>
* Simple tasks. These don't require much Emacs knowledge, they are
suitable for anyone from beginners to experts.
** Allow frames(terminals) created by emacsclient to inherit their environment
from the emacsclient process.
-** Remove the default toggling behavior of minor modes when called from elisp
-rather than interactively. This a trivial one-liner in easy-mode.el.
-
** Give Tar mode all the features of Archive mode.
** Create a category of errors called `process-error'
** Maybe reinterpret `parse-error' as a category of errors
and put some other errors under it.
-** A function to tell you the argument pattern of functions.
- See `function-arity' in http://www.loveshack.ukfsn.org/emacs/fx-misc.el.
-
** Make byte-compile warn when a doc string is too wide.
** Make byte-optimization warnings issue accurate line numbers.
** Give start-process the ability to direct standard-error
output to a different filter.
-** Make desktop.el save the "frame configuration" of Emacs (in some
- useful sense).
-
** Give desktop.el a feature to switch between different named desktops.
** Add a cpio mode, more or less like tar mode.
Check the assignments file for other packages which might go in and
have been missed.
-** Make keymaps a first-class Lisp object (this means a rewrite of
- keymap.c). What should it do apart from being opaque ?
- multiple inheritance ? faster where-is ? no more fix_submap_inheritance ?
- what else ?
-
-** Implement popular parts of the rest of the CL functions as compiler
- macros in cl-macs. [Is this still relevant now that cl-lib exists?]
-
** Make compiler warnings about functions that might be undefined at run time
smarter, so that they know which files are required by the file being
compiled and don't warn about functions defined in them.
-** Highlight rectangles (`mouse-track-rectangle-p' in XEmacs). Already in CUA,
- but it's a valuable feature worth making more general.
- [Basic support added 2013/10:
- http://lists.gnu.org/archive/html/emacs-devel/2013-10/msg00904.html ]
-
** Split out parts of lisp.h.
** Update the FAQ.
** Allow auto-compression-mode to use zlib calls if zlib is available.
[It's required for PNG, so may be linked anyhow.]
-** Add a --pristine startup flag which does -q --no-site-file plus
- ignoring X resources (Doze equivalents?) and most of the
- environment. What should not be ignored needs consideration.
- [Do the existing -Q and -D cover this, or is more needed?]
-
** Improve the GC (generational, incremental). (We may be able to use
the Boehm collector.) [See the Boehm-GC branch in CVS for work on this.]
(Requires recursing through display properties). Provide some way
to simulate mouse-clicks on marginal text without a mouse.
-** Implement Lisp functions to determine properly whether a character
- is displayable (particularly needed in XFree 4, sigh). Use it to
- define useful glyphs that may be displayed as images or unicodes
- (with ASCIIfied fallback via latin1-disp). Examples include
- box-drawing graphics in Custom buffers, W3 rules and tables, and
- tree displays generally, mode-line mail indicator. [See work done
- already for Emacs 23 and consult fx.]
-
** Extend ps-print to deal with multiple font sizes, images, and extra
encodings.
-** Make byte-compile avoid binding an expanded defsubst's args
- when the body only calls primitives.
-
** Use the XIE X extension, if available, for image display.
** Make monochrome images display using the foreground and background
+2015-02-23 Pete Williamson <petewil0@googlemail.com> (tiny change)
+
+ Use ${EXEEXT} more uniformly in makefiles
+ When porting Emacs to run on NaCl, we need to make sure that we always
+ call it with the proper extension (.nexe in this case) during the build.
+ * Makefile.in (EMACS): Append ${EXEEXT}.
+
2015-01-04 Paul Eggert <eggert@cs.ucla.edu>
Less 'make' chatter for leim
# Which Emacs to use to convert TIT files to Emacs Lisp files,
# and generate the file leim-list.el.
-EMACS = ../src/emacs
+EMACS = ../src/emacs${EXEEXT}
# How to run Emacs.
# Prevent any setting of EMACSLOADPATH in user environment causing problems.
+2015-03-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port etags to -DDEBUG
+ * etags.c (xnew, xrnew) [DEBUG]: Don't include chkmalloc.h, which
+ is not part of Emacs and is typically not installed.
+ Instead, just invoke xmalloc and xrealloc as usual.
+ Problem reported by Nicolas Richard in:
+ http://bugs.gnu.org/20191#20
+ (xrnew): Avoid no-longer-needed cast to 'char *'.
+ (xrealloc): First arg is now void *, not char *.
+
+2015-03-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Random minor fixes for movemail
+ * movemail.c: Include <stdbool.h> and <signal.h>.
+ (waitpid) [WINDOWSNT]: New macro.
+ (wait) [WINDOWSNT]: Remove.
+ (main, popmail, pop_retr, mbx_write, mbx_delimit_begin)
+ (mbx_delimit_end): Use bool for boolean.
+ (main): Simplify #if usage a bit.
+ (main): Don't assume EOF == -1. Prefer 'return' to 'exit'. Don't
+ possibly unlink lockname twice, as that's a race condition. Set
+ SIGCHLD to SIG_DFL to work around SysV misfeature. Check for fork
+ failure. Use waitpid, not wait, to avoid a race condition in the
+ unlikely case where we start up with a child.
+ (NOTOK, OK): Remove, in favor of plain boolean.
+ (popmail, pop_retr): Don't get confused about errno, e.g., ferror
+ need not set errno.
+ (popmail): Use fclose (mbf), not close (fileno (mbf)), to also
+ detect any stream-related errors (e.g., memory exhaustion).
+ (pop_retr): Report pop errors separately, since caller now does
+ errno reporting.
+ (mbx_write, mbx_delimit_begin, mbx_delimit_end): Check < 0, not ==
+ EOF, as it's a bit faster and (in theory) pickier.
+
+2015-02-27 Mark Laws <mdl@60hz.org>
+
+ Support daemon mode on MS-Windows (bug#19688)
+ * emacsclient.c (decode_options) [WINDOWSNT]: Don't reject empty
+ arguments for --alternate-editor.
+ (print_help_and_exit) [WINDOWSNT]: Don't refrain from advertising
+ empty arguments for --alternate-editor.
+ (start_daemon_and_retry_set_socket) [WINDOWSNT]: MS-Windows
+ specific code to start Emacs in daemon mode and wait for it to be
+ ready for client connections.
+
+2015-02-23 Pete Williamson <petewil0@googlemail.com> (tiny change)
+
+ Use ${EXEEXT} more uniformly in makefiles
+ * Makefile.in (EMACS): Append ${EXEEXT}.
+
+2015-02-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify binary I/O configuration
+ * etags.c: Include <sysstdio.h> rather than <stdio.h>.
+ (process_file_name, analyze_regex): Use FOPEN_BINARY rather than
+ hard-coded "b".
+
+2015-02-19 Eli Zaretskii <eliz@gnu.org>
+
+ * etags.c (process_file_name) [!DOS_NT]: Use "r", not "rb" in the
+ call to 'popen'. (Bug#19735)
+
+2015-02-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Better support for future plugins
+ See the thread containing:
+ http://lists.gnu.org/archive/html/emacs-devel/2015-02/msg00720.html
+ * make-docfile.c (write_globals): Generate code that #defines
+ Qxxx macros other than Qnil only if DEFINE_NONNIL_Q_SYMBOL_MACROS.
+ Qnil is safe to define even in plugins, since it must be zero for
+ other reasons.
+
2015-01-24 Paul Eggert <eggert@cs.ucla.edu>
Fix a couple of AM_V_GEN bugs
SHELL = @SHELL@
# Following ../lisp/Makefile.in.
-EMACS = ../src/emacs
+EMACS = ../src/emacs${EXEEXT}
EMACSOPT = -batch --no-site-file --no-site-lisp
# ==================== Things `configure' will edit ====================
display = NULL;
tty = 1;
}
-
- if (alternate_editor && alternate_editor[0] == '\0')
- {
- message (true, "--alternate-editor argument or ALTERNATE_EDITOR variable cannot be\n\
-an empty string");
- exit (EXIT_FAILURE);
- }
#endif /* WINDOWSNT */
}
Set filename of the TCP authentication file\n\
-a EDITOR, --alternate-editor=EDITOR\n\
Editor to fallback to if the server is not running\n"
-#ifndef WINDOWSNT
" If EDITOR is the empty string, start Emacs in daemon\n\
mode and try connecting again\n"
-#endif /* not WINDOWSNT */
"\n\
Report bugs with M-x report-emacs-bug.\n");
exit (EXIT_SUCCESS);
execvp ("emacs", d_argv);
message (true, "%s: error starting emacs daemon\n", progname);
}
-#endif /* WINDOWSNT */
+#else /* WINDOWSNT */
+ DWORD wait_result;
+ HANDLE w32_daemon_event;
+ STARTUPINFO si;
+ PROCESS_INFORMATION pi;
+
+ ZeroMemory (&si, sizeof si);
+ si.cb = sizeof si;
+ ZeroMemory (&pi, sizeof pi);
+
+ /* We start Emacs in daemon mode, and then wait for it to signal us
+ it is ready to accept client connections, by asserting an event
+ whose name is known to the daemon (defined by nt/inc/ms-w32.h). */
+
+ if (!CreateProcess (NULL, "emacs --daemon", NULL, NULL, FALSE,
+ CREATE_NO_WINDOW, NULL, NULL, &si, &pi))
+ {
+ char* msg = NULL;
+
+ FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM
+ | FORMAT_MESSAGE_ALLOCATE_BUFFER
+ | FORMAT_MESSAGE_ARGUMENT_ARRAY,
+ NULL, GetLastError (), 0, (LPTSTR)&msg, 0, NULL);
+ message (true, "%s: error starting emacs daemon (%s)\n", progname, msg);
+ exit (EXIT_FAILURE);
+ }
+
+ w32_daemon_event = CreateEvent (NULL, TRUE, FALSE, W32_DAEMON_EVENT);
+ if (w32_daemon_event == NULL)
+ {
+ message (true, "Couldn't create Windows daemon event");
+ exit (EXIT_FAILURE);
+ }
+ if ((wait_result = WaitForSingleObject (w32_daemon_event, INFINITE))
+ != WAIT_OBJECT_0)
+ {
+ char *msg = NULL;
+
+ switch (wait_result)
+ {
+ case WAIT_ABANDONED:
+ msg = "The daemon exited unexpectedly";
+ break;
+ case WAIT_TIMEOUT:
+ /* Can't happen due to INFINITE. */
+ default:
+ case WAIT_FAILED:
+ FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM
+ | FORMAT_MESSAGE_ALLOCATE_BUFFER
+ | FORMAT_MESSAGE_ARGUMENT_ARRAY,
+ NULL, GetLastError (), 0, (LPTSTR)&msg, 0, NULL);
+ break;
+ }
+ message (true, "Error: Could not start the Emacs daemon: %s\n", msg);
+ exit (EXIT_FAILURE);
+ }
+ CloseHandle (w32_daemon_event);
+
+ /* Try connecting, the daemon should have started by now. */
+ /* It's just a progress message, so don't pop a dialog if this is
+ emacsclientw. */
+ if (!w32_window_app ())
+ message (true,
+ "Emacs daemon should have started, trying to connect again\n");
+ if ((emacs_socket = set_socket (1)) == INVALID_SOCKET)
+ {
+ message (true,
+ "Error: Cannot connect even after starting the Emacs daemon\n");
+ exit (EXIT_FAILURE);
+ }
+#endif /* WINDOWSNT */
}
int
#include <stdarg.h>
#include <stdlib.h>
#include <string.h>
-#include <stdio.h>
+#include <sysstdio.h>
#include <ctype.h>
#include <errno.h>
#include <sys/types.h>
* SYNOPSIS: Type *xnew (int n, Type);
* void xrnew (OldPointer, int n, Type);
*/
-#if DEBUG
-# include "chkmalloc.h"
-# define xnew(n,Type) ((Type *) trace_malloc (__FILE__, __LINE__, \
- (n) * sizeof (Type)))
-# define xrnew(op,n,Type) ((op) = (Type *) trace_realloc (__FILE__, __LINE__, \
- (char *) (op), (n) * sizeof (Type)))
-#else
-# define xnew(n,Type) ((Type *) xmalloc ((n) * sizeof (Type)))
-# define xrnew(op,n,Type) ((op) = (Type *) xrealloc ( \
- (char *) (op), (n) * sizeof (Type)))
-#endif
+#define xnew(n, Type) ((Type *) xmalloc ((n) * sizeof (Type)))
+#define xrnew(op, n, Type) ((op) = (Type *) xrealloc (op, (n) * sizeof (Type)))
typedef void Lang_function (FILE *);
static void linebuffer_init (linebuffer *);
static void linebuffer_setlen (linebuffer *, int);
static void *xmalloc (size_t);
-static void *xrealloc (char *, size_t);
+static void *xrealloc (void *, size_t);
\f
static char searchar = '/'; /* use /.../ searches */
if (real_name == compressed_name)
{
char *cmd = concat (compr->command, " ", real_name);
- inf = popen (cmd, "rb");
+ inf = popen (cmd, "r" FOPEN_BINARY);
free (cmd);
}
else
- inf = fopen (real_name, "rb");
+ inf = fopen (real_name, "r" FOPEN_BINARY);
if (inf == NULL)
{
perror (real_name);
char *regexfile = regex_arg + 1;
/* regexfile is a file containing regexps, one per line. */
- regexfp = fopen (regexfile, "rb");
+ regexfp = fopen (regexfile, "r" FOPEN_BINARY);
if (regexfp == NULL)
pfatal (regexfile);
linebuffer_init (®exbuf);
}
static void *
-xrealloc (char *ptr, size_t size)
+xrealloc (void *ptr, size_t size)
{
void *result = realloc (ptr, size);
if (result == NULL)
globals[i].name, globals[i].name);
}
else if (globals[i].type == SYMBOL)
- printf (("DEFINE_LISP_SYMBOL_BEGIN (%s)\n"
- "#define i%s %d\n"
- "#define %s builtin_lisp_symbol (i%s)\n"
- "DEFINE_LISP_SYMBOL_END (%s)\n\n"),
- globals[i].name, globals[i].name, symnum++,
- globals[i].name, globals[i].name, globals[i].name);
+ printf (("#define i%s %d\n"
+ "DEFINE_LISP_SYMBOL (%s)\n"),
+ globals[i].name, symnum++, globals[i].name);
else
{
if (globals[i].flags & DEFUN_noreturn)
puts ("#ifdef DEFINE_SYMBOLS");
puts ("static char const *const defsym_name[] = {");
for (int i = 0; i < num_globals; i++)
- {
- if (globals[i].type == SYMBOL)
- printf ("\t\"%s\",\n", globals[i].v.svalue);
- while (i + 1 < num_globals
- && strcmp (globals[i].name, globals[i + 1].name) == 0)
- i++;
- }
+ if (globals[i].type == SYMBOL)
+ printf ("\t\"%s\",\n", globals[i].v.svalue);
puts ("};");
puts ("#endif");
+
+ puts ("#define Qnil builtin_lisp_symbol (0)");
+ puts ("#if DEFINE_NON_NIL_Q_SYMBOL_MACROS");
+ num_symbols = 0;
+ for (int i = 0; i < num_globals; i++)
+ if (globals[i].type == SYMBOL && num_symbols++ != 0)
+ printf ("# define %s builtin_lisp_symbol (%d)\n",
+ globals[i].name, num_symbols - 1);
+ puts ("#endif");
}
\f
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/file.h>
+#include <stdbool.h>
#include <stdio.h>
#include <errno.h>
#include <time.h>
#include <getopt.h>
#include <unistd.h>
#include <fcntl.h>
+#include <signal.h>
#include <string.h>
#include "syswait.h"
#ifdef MAIL_USE_POP
#undef access
#undef unlink
#define fork() 0
-#define wait(var) (*(var) = 0)
+#define waitpid(child, var, flags) (*(var) = 0)
/* Unfortunately, Samba doesn't seem to properly lock Unix files even
though the locking call succeeds (and indeed blocks local access from
other NT programs). If you have direct file access using an NFS
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_write (char *line, int len, FILE *mbf);
-static int mbx_delimit_begin (FILE *mbf);
-static int mbx_delimit_end (FILE *mbf);
+static int popmail (char *, char *, bool, char *, bool);
+static bool pop_retr (popserver, int, FILE *);
+static bool mbx_write (char *, int, FILE *);
+static bool mbx_delimit_begin (FILE *);
+static bool mbx_delimit_end (FILE *);
#endif
#if (defined MAIL_USE_MAILLOCK \
int indesc, outdesc;
ssize_t nread;
int wait_status;
- int c, preserve_mail = 0;
+ int c;
+ bool preserve_mail = false;
#ifndef MAIL_USE_SYSTEM_LOCK
struct stat st;
int tem;
- char *lockname;
char *tempname;
size_t inname_len, inname_dirlen;
int desc;
#endif /* not MAIL_USE_SYSTEM_LOCK */
-#ifdef MAIL_USE_MAILLOCK
- char *spool_name;
-#endif
+ char *spool_name = 0;
#ifdef MAIL_USE_POP
- int pop_reverse_order = 0;
+ bool pop_reverse_order = false;
# define ARGSTR "pr"
#else /* ! MAIL_USE_POP */
# define ARGSTR "p"
delete_lockname = 0;
- while ((c = getopt (argc, argv, ARGSTR)) != EOF)
+ while (0 <= (c = getopt (argc, argv, ARGSTR)))
{
switch (c) {
#ifdef MAIL_USE_POP
case 'r':
- pop_reverse_order = 1;
+ pop_reverse_order = true;
break;
#endif
case 'p':
- preserve_mail++;
+ preserve_mail = true;
break;
default:
- exit (EXIT_FAILURE);
+ return EXIT_FAILURE;
}
}
#else
fprintf (stderr, "Usage: movemail [-p] inbox destfile%s\n", "");
#endif
- exit (EXIT_FAILURE);
+ return EXIT_FAILURE;
}
inname = argv[optind];
status = popmail (inname + 3, outname, preserve_mail,
(argc - optind == 3) ? argv[optind+2] : NULL,
pop_reverse_order);
- exit (status);
+ return status;
}
if (setuid (getuid ()) < 0)
#endif /* MAIL_USE_POP */
#ifndef DISABLE_DIRECT_ACCESS
+
+ char *lockname = 0;
+
#ifndef MAIL_USE_MMDF
#ifndef MAIL_USE_SYSTEM_LOCK
#ifdef MAIL_USE_MAILLOCK
spool_name = mail_spool_name (inname);
- if (spool_name)
- {
-#ifdef lint
- lockname = 0;
-#endif
- }
- else
#endif
+ if (! spool_name)
{
/* Use a lock file named after our first argument with .lock appended:
If it exists, the mail file is locked. */
continue;
tempname = xmalloc (inname_dirlen + sizeof "EXXXXXX");
- while (1)
+ while (true)
{
/* Create the lock file, but not under the lock file name. */
/* Give up if cannot do that. */
{
time_t now = time (0);
if (st.st_ctime < now - 300)
- unlink (lockname);
+ {
+ unlink (lockname);
+ lockname = 0;
+ }
}
}
#endif /* not MAIL_USE_SYSTEM_LOCK */
#endif /* not MAIL_USE_MMDF */
- if (fork () == 0)
+#ifdef SIGCHLD
+ signal (SIGCHLD, SIG_DFL);
+#endif
+
+ pid_t child = fork ();
+ if (child < 0)
+ fatal ("Error in fork; %s", strerror (errno), 0);
+
+ if (child == 0)
{
int lockcount = 0;
int status = 0;
#if defined (MAIL_USE_MAILLOCK) && defined (HAVE_TOUCHLOCK)
- time_t touched_lock;
-# ifdef lint
- touched_lock = 0;
-# endif
+ time_t touched_lock IF_LINT (= 0);
#endif
if (setuid (getuid ()) < 0 || setregid (-1, real_gid) < 0)
#ifdef MAIL_USE_MAILLOCK
if (spool_name)
{
- /* The "0 - " is to make it a negative number if maillock returns
+ /* The "-" is to make it a negative number if maillock returns
non-zero. */
- status = 0 - maillock (spool_name, 1);
+ status = - maillock (spool_name, 1);
#ifdef HAVE_TOUCHLOCK
touched_lock = time (0);
#endif
{
char buf[1024];
- while (1)
+ while (true)
{
nread = read (indesc, buf, sizeof buf);
if (nread < 0)
#ifdef MAIL_USE_SYSTEM_LOCK
if (! preserve_mail)
{
- if (ftruncate (indesc, 0L) != 0)
+ if (ftruncate (indesc, 0) != 0)
pfatal_with_name (inname);
}
#endif /* MAIL_USE_SYSTEM_LOCK */
if (spool_name)
mailunlock ();
#endif
- exit (EXIT_SUCCESS);
+ return EXIT_SUCCESS;
}
- wait (&wait_status);
+ if (waitpid (child, &wait_status, 0) < 0)
+ fatal ("Error in waitpid; %s", strerror (errno), 0);
if (!WIFEXITED (wait_status))
- exit (EXIT_FAILURE);
+ return EXIT_FAILURE;
else if (WEXITSTATUS (wait_status) != 0)
- exit (WEXITSTATUS (wait_status));
+ return WEXITSTATUS (wait_status);
-#if !defined (MAIL_USE_MMDF) && !defined (MAIL_USE_SYSTEM_LOCK)
-#ifdef MAIL_USE_MAILLOCK
- if (! spool_name)
-#endif /* MAIL_USE_MAILLOCK */
+ if (lockname)
unlink (lockname);
-#endif /* not MAIL_USE_MMDF and not MAIL_USE_SYSTEM_LOCK */
#endif /* ! DISABLE_DIRECT_ACCESS */
#include <pwd.h>
#include <string.h>
-#define NOTOK (-1)
-#define OK 0
-
-static char Errmsg[200]; /* POP errors, at least, can exceed
- the original length of 80. */
-
/*
* The full valid syntax for a POP mailbox specification for movemail
* is "po:username:hostname". The ":hostname" is optional; if it is
*/
static int
-popmail (char *mailbox, char *outfile, int preserve, char *password, int reverse_order)
+popmail (char *mailbox, char *outfile, bool preserve, char *password,
+ bool reverse_order)
{
int nmsgs, nbytes;
- register int i;
+ int i;
int mbfi;
FILE *mbf;
popserver server;
}
}
- if ((mbf = fdopen (mbfi, "wb")) == NULL)
+ mbf = fdopen (mbfi, "wb");
+ if (!mbf)
{
pop_close (server);
error ("Error in fdopen: %s", strerror (errno), 0);
}
for (i = start; i * increment <= end * increment; i += increment)
- {
- if (mbx_delimit_begin (mbf) != OK
- || pop_retr (server, i, mbf) != OK)
- {
- error ("%s", Errmsg, 0);
- close (mbfi);
- return EXIT_FAILURE;
- }
- mbx_delimit_end (mbf);
- fflush (mbf);
- if (ferror (mbf))
- {
- error ("Error in fflush: %s", strerror (errno), 0);
- pop_close (server);
- close (mbfi);
- return EXIT_FAILURE;
- }
- }
+ if (! (mbx_delimit_begin (mbf)
+ && pop_retr (server, i, mbf)
+ && mbx_delimit_end (mbf)
+ && fflush (mbf) == 0))
+ {
+ if (errno)
+ error ("Error in POP retrieving: %s", strerror (errno), 0);
+ pop_close (server);
+ fclose (mbf);
+ return EXIT_FAILURE;
+ }
if (fsync (mbfi) != 0 && errno != EINVAL)
{
error ("Error in fsync: %s", strerror (errno), 0);
- close (mbfi);
+ fclose (mbf);
return EXIT_FAILURE;
}
- if (close (mbfi) != 0)
+ if (fclose (mbf) != 0)
{
- error ("Error in close: %s", strerror (errno), 0);
+ error ("Error in fclose: %s", strerror (errno), 0);
return EXIT_FAILURE;
}
return EXIT_SUCCESS;
}
-static int
+static bool
pop_retr (popserver server, int msgno, FILE *arg)
{
char *line;
if (pop_retrieve_first (server, msgno, &line))
{
- snprintf (Errmsg, sizeof Errmsg, "Error from POP server: %s", pop_error);
- return (NOTOK);
+ error ("Error from POP server: %s", pop_error, 0);
+ errno = 0;
+ return false;
}
while ((ret = pop_retrieve_next (server, &line)) >= 0)
if (! line)
break;
- if (mbx_write (line, ret, arg) != OK)
+ if (! mbx_write (line, ret, arg))
{
- strcpy (Errmsg, strerror (errno));
+ int write_errno = errno;
pop_close (server);
- return (NOTOK);
+ errno = write_errno;
+ return false;
}
}
if (ret)
{
- snprintf (Errmsg, sizeof Errmsg, "Error from POP server: %s", pop_error);
- return (NOTOK);
+ error ("Error from POP server: %s", pop_error, 0);
+ errno = 0;
+ return false;
}
- return (OK);
+ return true;
}
-static int
+static bool
mbx_write (char *line, int len, FILE *mbf)
{
#ifdef MOVEMAIL_QUOTE_POP_FROM_LINES
&& (a[4] == ' '))
if (IS_FROM_LINE (line))
{
- if (fputc ('>', mbf) == EOF)
- return (NOTOK);
+ if (fputc ('>', mbf) < 0)
+ return false;
}
#endif
if (line[0] == '\037')
{
- if (fputs ("^_", mbf) == EOF)
- return (NOTOK);
+ if (fputs ("^_", mbf) < 0)
+ return false;
line++;
len--;
}
- if (fwrite (line, 1, len, mbf) != len)
- return (NOTOK);
- if (fputc (0x0a, mbf) == EOF)
- return (NOTOK);
- return (OK);
+ return fwrite (line, 1, len, mbf) == len && 0 <= fputc ('\n', mbf);
}
-static int
+static bool
mbx_delimit_begin (FILE *mbf)
{
time_t now = time (NULL);
struct tm *ltime = localtime (&now);
if (!ltime)
- return NOTOK;
+ return false;
char fromline[100];
if (! strftime (fromline, sizeof fromline,
"From movemail %a %b %e %T %Y\n", ltime))
- return NOTOK;
- if (fputs (fromline, mbf) == EOF)
- return (NOTOK);
- return (OK);
+ {
+ errno = EOVERFLOW;
+ return false;
+ }
+ return 0 <= fputs (fromline, mbf);
}
-static int
+static bool
mbx_delimit_end (FILE *mbf)
{
- if (putc ('\n', mbf) == EOF)
- return (NOTOK);
- return (OK);
+ return 0 <= putc ('\n', mbf);
}
#endif /* MAIL_USE_POP */
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# undef opendir
# define opendir rpl_opendir
+# define GNULIB_defined_opendir 1
# endif
_GL_FUNCDECL_RPL (opendir, DIR *, (const char *dir_name) _GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_RPL (opendir, DIR *, (const char *dir_name));
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# undef closedir
# define closedir rpl_closedir
+# define GNULIB_defined_closedir 1
# endif
_GL_FUNCDECL_RPL (closedir, int, (DIR *dirp) _GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_RPL (closedir, int, (DIR *dirp));
--- /dev/null
+/* dirfd.c -- return the file descriptor associated with an open DIR*
+
+ Copyright (C) 2001, 2006, 2008-2015 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 Jim Meyering. */
+
+#include <config.h>
+
+#include <dirent.h>
+#include <errno.h>
+
+int
+dirfd (DIR *dir_p)
+{
+ int fd = DIR_TO_FD (dir_p);
+ if (fd == -1)
+ errno = ENOTSUP;
+ return fd;
+}
That way, barring race conditions, fd_clone_opendir returns a
stream whose file descriptor is FD.
- If REPLACE_CHDIR or CWD is null, use opendir ("/proc/self/fd/...",
+ If REPLACE_FCHDIR or CWD is null, use opendir ("/proc/self/fd/...",
falling back on fchdir metadata. Otherwise, CWD is a saved version
of the working directory; use fchdir/opendir(".")/restore_cwd(CWD). */
static DIR *
if (! dir && EXPECTED_ERRNO (saved_errno))
{
char const *name = _gl_directory_name (fd);
- return (name ? opendir (name) : NULL);
+ DIR *dp = name ? opendir (name) : NULL;
+
+ /* The caller has done an elaborate dance to arrange for opendir to
+ consume just the right file descriptor. If dirfd returns -1,
+ though, we're on a system like mingw where opendir does not
+ consume a file descriptor. Consume it via 'dup' instead. */
+ if (dp && dirfd (dp) < 0)
+ dup (fd);
+
+ return dp;
}
# endif
errno = saved_errno;
return dtablesize;
}
-#elif HAVE_GETDTABLESIZE
+#else
+# include <limits.h>
# include <sys/resource.h>
-# undef getdtablesize
-int
-rpl_getdtablesize(void)
-{
- /* To date, this replacement is only compiled for Cygwin 1.7.25,
- which auto-increased the RLIMIT_NOFILE soft limit until it
- hits the compile-time constant hard limit of 3200. Although
- that version of cygwin supported a child process inheriting
- a smaller soft limit, the smaller limit is not enforced, so
- we might as well just report the hard limit. */
- struct rlimit lim;
- if (!getrlimit (RLIMIT_NOFILE, &lim) && lim.rlim_max != RLIM_INFINITY)
- return lim.rlim_max;
- return getdtablesize ();
-}
+# ifndef RLIM_SAVED_CUR
+# define RLIM_SAVED_CUR RLIM_INFINITY
+# endif
+# ifndef RLIM_SAVED_MAX
+# define RLIM_SAVED_MAX RLIM_INFINITY
+# endif
-#elif defined _SC_OPEN_MAX
+# ifdef __CYGWIN__
+ /* Cygwin 1.7.25 auto-increases the RLIMIT_NOFILE soft limit until it
+ hits the compile-time constant hard limit of 3200. We might as
+ well just report the hard limit. */
+# define rlim_cur rlim_max
+# endif
int
getdtablesize (void)
{
- return sysconf (_SC_OPEN_MAX);
+ struct rlimit lim;
+
+ if (getrlimit (RLIMIT_NOFILE, &lim) == 0
+ && 0 <= lim.rlim_cur && lim.rlim_cur <= INT_MAX
+ && lim.rlim_cur != RLIM_INFINITY
+ && lim.rlim_cur != RLIM_SAVED_CUR
+ && lim.rlim_cur != RLIM_SAVED_MAX)
+ return lim.rlim_cur;
+
+ return INT_MAX;
}
#endif
const struct option *p;
struct option_list *next;
} *ambig_list = NULL;
+#ifdef _LIBC
+/* malloc() not used for _LIBC to simplify failure messages. */
+# define free_option_list(l)
+#else
+# define free_option_list(l) \
+ while (l != NULL) \
+ { \
+ struct option_list *pn = l->next; \
+ free (l); \
+ l = pn; \
+ }
+#endif
int exact = 0;
+ int ambig = 0;
int indfound = -1;
int option_index;
pfound = p;
indfound = option_index;
}
+ else if (ambig)
+ ; /* Taking simpler path to handling ambiguities. */
else if (long_only
|| pfound->has_arg != p->has_arg
|| pfound->flag != p->flag
|| pfound->val != p->val)
{
/* Second or later nonexact match found. */
+#ifdef _LIBC
+ struct option_list *newp = alloca (sizeof (*newp));
+#else
struct option_list *newp = malloc (sizeof (*newp));
- newp->p = p;
- newp->next = ambig_list;
- ambig_list = newp;
+ if (newp == NULL)
+ {
+ free_option_list (ambig_list);
+ ambig_list = NULL;
+ ambig = 1; /* Use simpler fallback message. */
+ }
+ else
+#endif
+ {
+ newp->p = p;
+ newp->next = ambig_list;
+ ambig_list = newp;
+ }
}
}
- if (ambig_list != NULL && !exact)
+ if ((ambig || ambig_list) && !exact)
{
- if (print_errors)
+ if (print_errors && ambig_list)
{
struct option_list first;
first.p = pfound;
fputc ('\n', stderr);
#endif
}
+ else if (print_errors && ambig)
+ {
+ fprintf (stderr,
+ _("%s: option '%s' is ambiguous\n"),
+ argv[0], argv[d->optind]);
+ }
d->__nextchar += strlen (d->__nextchar);
d->optind++;
d->optopt = 0;
+ free_option_list (ambig_list);
return '?';
}
- while (ambig_list != NULL)
- {
- struct option_list *pn = ambig_list->next;
- free (ambig_list);
- ambig_list = pn;
- }
+ free_option_list (ambig_list);
if (pfound != NULL)
{
## end gnulib module dirent
+## begin gnulib module dirfd
+
+if gl_GNULIB_ENABLED_dirfd
+
+endif
+EXTRA_DIST += dirfd.c
+
+EXTRA_libgnu_a_SOURCES += dirfd.c
+
+## end gnulib module dirfd
+
## begin gnulib module dosname
if gl_GNULIB_ENABLED_dosname
#ifndef _@GUARD_PREFIX@_SIGNAL_H
#define _@GUARD_PREFIX@_SIGNAL_H
-/* 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>.
+/* Mac OS X 10.3, FreeBSD 6.4, OpenBSD 3.8, OSF/1 4.0, Solaris 2.6, Android
+ declare pthread_sigmask in <pthread.h>, not in <signal.h>.
But avoid namespace pollution on glibc systems.*/
#if (@GNULIB_PTHREAD_SIGMASK@ || defined GNULIB_POSIXCHECK) \
- && ((defined __APPLE__ && defined __MACH__) || defined __FreeBSD__ || defined __OpenBSD__ || defined __osf__ || defined __sun) \
+ && ((defined __APPLE__ && defined __MACH__) \
+ || defined __FreeBSD__ || defined __OpenBSD__ || defined __osf__ \
+ || defined __sun || defined __ANDROID__) \
&& ! defined __GLIBC__
# include <pthread.h>
#endif
# define struct_stat64 struct stat64
#else
# define struct_stat64 struct stat
+# define __try_tempname try_tempname
# define __gen_tempname gen_tempname
# define __getpid getpid
# define __gettimeofday gettimeofday
static const char letters[] =
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
-/* Generate a temporary file name based on TMPL. TMPL must match the
- rules for mk[s]temp (i.e. end in "XXXXXX", possibly with a suffix).
- The name constructed does not exist at the time of the call to
- __gen_tempname. TMPL is overwritten with the result.
-
- KIND may be one of:
- __GT_NOCREATE: simply verify that the name does not exist
- at the time of the call.
- __GT_FILE: create the file using open(O_CREAT|O_EXCL)
- and return a read-write fd. The file is mode 0600.
- __GT_DIR: create a directory, which will be mode 0700.
-
- We use a clever algorithm to get hard-to-predict names. */
int
-__gen_tempname (char *tmpl, int suffixlen, int flags, int kind)
+__try_tempname (char *tmpl, int suffixlen, void *args,
+ int (*tryfunc) (char *, void *))
{
int len;
char *XXXXXX;
unsigned int count;
int fd = -1;
int save_errno = errno;
- struct_stat64 st;
/* A lower bound on the number of temporary files to attempt to
generate. The maximum total number of temporary file names that
v /= 62;
XXXXXX[5] = letters[v % 62];
- switch (kind)
- {
- case __GT_FILE:
- fd = __open (tmpl,
- (flags & ~O_ACCMODE)
- | O_RDWR | O_CREAT | O_EXCL, S_IRUSR | S_IWUSR);
- break;
-
- case __GT_DIR:
- fd = __mkdir (tmpl, S_IRUSR | S_IWUSR | S_IXUSR);
- break;
-
- case __GT_NOCREATE:
- /* This case is backward from the other three. __gen_tempname
- succeeds if __xstat fails because the name does not exist.
- Note the continue to bypass the common logic at the bottom
- of the loop. */
- if (__lxstat64 (_STAT_VER, tmpl, &st) < 0)
- {
- if (errno == ENOENT)
- {
- __set_errno (save_errno);
- return 0;
- }
- else
- /* Give up now. */
- return -1;
- }
- continue;
-
- default:
- assert (! "invalid KIND in __gen_tempname");
- abort ();
- }
-
+ fd = tryfunc (tmpl, args);
if (fd >= 0)
{
__set_errno (save_errno);
__set_errno (EEXIST);
return -1;
}
+
+static int
+try_file (char *tmpl, void *flags)
+{
+ int *openflags = flags;
+ return __open (tmpl,
+ (*openflags & ~O_ACCMODE)
+ | O_RDWR | O_CREAT | O_EXCL, S_IRUSR | S_IWUSR);
+}
+
+static int
+try_dir (char *tmpl, void *flags)
+{
+ return __mkdir (tmpl, S_IRUSR | S_IWUSR | S_IXUSR);
+}
+
+static int
+try_nocreate (char *tmpl, void *flags)
+{
+ struct_stat64 st;
+
+ if (__lxstat64 (_STAT_VER, tmpl, &st) == 0)
+ __set_errno (EEXIST);
+ return errno == ENOENT ? 0 : -1;
+}
+
+/* Generate a temporary file name based on TMPL. TMPL must match the
+ rules for mk[s]temp (i.e. end in "XXXXXX", possibly with a suffix).
+ The name constructed does not exist at the time of the call to
+ __gen_tempname. TMPL is overwritten with the result.
+
+ KIND may be one of:
+ __GT_NOCREATE: simply verify that the name does not exist
+ at the time of the call.
+ __GT_FILE: create the file using open(O_CREAT|O_EXCL)
+ and return a read-write fd. The file is mode 0600.
+ __GT_DIR: create a directory, which will be mode 0700.
+
+ We use a clever algorithm to get hard-to-predict names. */
+int
+__gen_tempname (char *tmpl, int suffixlen, int flags, int kind)
+{
+ int (*tryfunc) (char *, void *);
+
+ switch (kind)
+ {
+ case __GT_FILE:
+ tryfunc = try_file;
+ break;
+
+ case __GT_DIR:
+ tryfunc = try_dir;
+ break;
+
+ case __GT_NOCREATE:
+ tryfunc = try_nocreate;
+ break;
+
+ default:
+ assert (! "invalid KIND in __gen_tempname");
+ abort ();
+ }
+ return __try_tempname (tmpl, suffixlen, &flags, tryfunc);
+}
# define GT_NOCREATE 2
# endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+
/* Generate a temporary file name based on TMPL. TMPL must match the
rules for mk[s]temp (i.e. end in "XXXXXX", possibly with a suffix).
The name constructed does not exist at the time of the call to
We use a clever algorithm to get hard-to-predict names. */
extern int gen_tempname (char *tmpl, int suffixlen, int flags, int kind);
+/* Similar to gen_tempname, but TRYFUNC is called for each temporary
+ name to try. If TRYFUNC returns a non-negative number, TRY_GEN_TEMPNAME
+ returns with this value. Otherwise, if errno is set to EEXIST, another
+ name is tried, or else TRY_GEN_TEMPNAME returns -1. */
+extern int try_tempname (char *tmpl, int suffixlen, void *args,
+ int (*tryfunc) (char *, void *));
+
+#ifdef __cplusplus
+}
+#endif
+
#endif /* GL_TEMPNAME_H */
-2015-03-22 Richard Stallman <rms@gnu.org>
+2015-04-05 Richard Stallman <rms@gnu.org>
* mail/rmail.el (rmail-show-message-1): When displaying a mime message,
indicate start and finish in the echo area.
(browse-url-firefox-arguments)
(browse-url-firefox-startup-arguments): Doc fix.
-2015-02-01 Joakim Verona <joakim@verona.se>
- Support for the new Xwidget feature.
- * xwidget.el:
+2015-04-05 Pete Williamson <petewil@chromium.org> (tiny-change)
-2015-02-01 Grégoire Jadi <daimrod@gmail.com>
- Support for testing xwidgets
- * emacs-parallel/parallell-remote.el, emacs-parallel/parallell-xwidget.el:
- * emacs-parallel/parallell.el:
+ Fix .emacs and .emacs.d/init file recursion problem for NaCl
+ * files.el (file-truename): Add NaCl to the exception list ms-dos uses.
+
+2015-04-04 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-mode.el (c-font-lock-init): Revert 2015-02-01 change
+ "Stop Font Lock forcing fontification from BOL." (Bug#20245)
+
+2015-04-04 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package--download-and-read-archives): Add
+ `package-archives' to `package--downloads-in-progress' instead of
+ overwriting it.
+ (package--with-work-buffer-async): Protect macro arguments.
+
+2015-04-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-cache.el (tramp-flush-directory-property): Quote directory
+ name when used in regexp.
+
+2015-04-04 Alan Mackenzie <acm@muc.de>
+
+ Fix debbugs#20240 part two (jit-lock error during `comment-dwim').
+
+ * jit-lock.el (jit-lock-after-change): Widen the buffer before
+ putting 'fontified text properties.
+
+2015-04-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-cache.el (tramp-flush-file-property)
+ (tramp-flush-directory-property): Use `directory-file-name' of the
+ truename. (Bug#20249)
+
+2015-04-03 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ * pcmpl-unix.el (pcmpl-ssh-known-hosts): Use `char-before' instead
+ of `looking-back' (bug#17284).
+
+2015-04-03 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/js.el (js-indent-line): Do nothing when bol is inside
+ a string (https://github.com/mooz/js2-mode/issues/227).
+
+2015-04-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * abbrev.el (define-abbrev-table): Treat a non-string "docstring" as
+ part of the "props" arguments rather than silently ignoring it.
+
+ * emacs-lisp/lisp-mnt.el (lm-version): Don't burp in a non-file buffer.
+
+2015-04-01 Alan Mackenzie <acm@muc.de>
+
+ Fix the CC Mode fixes from 2015-03-30. Fixes debbugs#20240.
+
+ * progmodes/cc-mode.el (c-extend-after-change-region):
+ Widen before applying text properties.
+ * progmodes/cc-langs.el (c-before-font-lock-functions): Update an
+ entry to a new function name.
+
+2015-04-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ * emacs-lisp/package.el: Spelling fixes and use active voice.
+
+2015-04-01 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el: Implement asynchronous refreshing.
+ (package--with-work-buffer-async)
+ (package--check-signature-content)
+ (package--update-downloads-in-progress): New functions.
+ (package--check-signature, package--download-one-archive)
+ (package--download-and-read-archives, package-refresh-contents):
+ Optional arguments for async usage.
+ (package--post-download-archives-hook): New variable. Hook run
+ after every refresh.
+
+ * emacs-lisp/package.el: Make package-menu asynchronous.
+ (package-menu-async): New variable. Controls whether
+ `list-packages' is asynchronous.
+ (list-packages): Now asynchronous by default.
+ (package-menu--new-package-list): Always buffer-local.
+ (package-menu--post-refresh)
+ (package-menu--find-and-notify-upgrades)
+ (package-menu--populate-new-package-list): New functions.
+
+2015-03-31 Simen Heggestøyl <simenheg@gmail.com>
+
+ * textmodes/css-mode.el (css-mode): Derive from `prog-mode'.
+
+2015-03-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * jit-lock.el (jit-lock--run-functions): Fix min/max copy&paste error.
+
+ Let jit-lock know the result of font-lock-extend-region-functions.
+ * jit-lock.el (jit-lock--run-functions): New function.
+ (jit-lock-fontify-now): Use it. Handle fontification bounds more
+ precisely in case the backend functions fontify more than requested.
+ Don't round up to whole lines since that shouldn't be needed
+ any more.
+ * font-lock.el (font-lock-fontify-region-function): Adjust docstring.
+ (font-lock-inhibit-thing-lock): Make obsolete.
+ (font-lock-default-fontify-region): Return the bounds actually used.
+
+ * emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value):
+ Fix compilation error.
+
+2015-03-30 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el: Reorganize package.el and divide it with
+ page-breaks and comments.
+
+2015-03-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-base.el (make-instance) <eieio-named>: New instance
+ which stores the old-style object name argument into the
+ object-name field.
+
+2015-03-30 Alan Mackenzie <acm@muc.de>
+
+ Correct calculation of CC Mode's font-lock region.
+
+ * progmodes/cc-mode.el (c-fl-decl-start): Rename from
+ c-set-fl-decl-start. Change signature such that nil is returned
+ when no declaration is found.
+ (c-change-expand-fl-region): Rename from
+ c-change-set-fl-decl-start. This now also handles expanding the
+ font lock region to whole lines.
+ (c-context-expand-fl-region): Rename from
+ c-context-set-fl-decl-start. This now also handles expanding the
+ font lock region to whole lines.
+ (c-font-lock-fontify-region): When a change font lock region is
+ spuriously enlarged to the beginning-of-line by jit-lock, fontify
+ the extra bit separately from the region calculated by CC Mode.
+ (c-extend-after-change-region): Explicitly apply 'fontified
+ properties to the extended bits of the font lock region.
+
+ * progmodes/cc-langs.el (c-before-font-lock-functions)
+ (c-before-context-fontification-functions): Use new names for
+ existing functions (see above).
+
+2015-03-30 Richard Ryniker <ryniker@alum.mit.edu> (tiny change)
+
+ * mail/sendmail.el (sendmail-send-it): Do not attempt to switch
+ to non-existent buffer (errbuf is not created when customization
+ variable mail-interactive is nil). (Bug#20211)
+
+2015-03-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el (smie-backward-sexp-command)
+ (smie-forward-sexp-command): Don't pretend the arg is optional
+ (bug#20205).
+
+2015-03-29 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-syntax-before-regexp-re):
+ Detect regexps after `!'. (Bug#19285)
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords):
+ Use `font-lock-constant-face' for nil, true and false.
+ Highlight `self' as a keyword. (Bug#17733)
+
+2015-03-29 Nobuyoshi Nakada <nobu@ruby-lang.org>
+
+ * progmodes/ruby-mode.el (ruby-syntax-before-regexp-re):
+ Expect beginning of regexp also after open brace or vertical bar.
+ (Bug#20026)
+
+2015-03-28 Jan Djärv <jan.h.d@swipnet.se>
+
+ * emacs-lisp/package.el (package-refresh-contents): Fix spelling
+ error in previous change.
+
+2015-03-28 Tom Willemse <tom@ryuslash.org> (tiny change)
+
+ * elec-pair.el (electric-pair-local-mode): New command.
+ (electric-pair-mode): Mention `electric-pair-local-mode' in the
+ docstring.
+
+2015-03-28 Jan Djärv <jan.h.d@swipnet.se>
+
+ * emacs-lisp/package.el (package-refresh-contents): Add a message at
+ the end so it does not appear to have hanged (Bug#17879).
+
+2015-03-27 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * font-lock.el (font-lock--remove-face-from-text-property):
+ New function. Adapted from the previously commented out
+ remove-single-text-property.
+ Remove previously unused and commented out auxiliary function
+ remove-text-property and obsolete comment.
+ * comint.el (comint-output-filter): Use it to remove
+ comint-highlight-prompt.
+ (comint-snapshot-last-prompt, comint-output-filter):
+ Use font-lock-prepend-text-property for comint-highlight-prompt.
+ (Bug#20084)
+
+2015-03-26 Daniel Colascione <dancol@dancol.org>
+ * progmodes/python.el
+ (python-indent-guess-indent-offset-verbose): New defcustom.
+ (python-indent-guess-indent-offset): Use it.
+
+2015-03-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el (defclass): Change internal name so as to make
+ sure only EIEIO files should have "eieio--" prefixes in their .elc.
+
+ * emacs-lisp/cl-macs.el (cl-dolist, cl-dotimes): Silence byte-compiler.
+
+2015-03-26 Boruch Baum <boruch_baum@gmx.com> (tiny change)
+
+ * bookmark.el (bookmark-show-all-annotations): Sort them (bug#20177).
+
+2015-03-25 Dmitry Gutov <dgutov@yandex.ru>
+
+ * json.el (json-special-chars): Don't treat `/' specially, there's
+ no need to.
+ (json-encode-string): Only escape quotation mark, backslash and
+ the control characters U+0000 to U+001F.
+
+2015-03-25 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine):
+ Don't complain about args starting with _.
+
+2015-03-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * international/mule-cmds.el (mule--ucs-names-annotation): New func.
+ (read-char-by-name): Use it.
+
+ * xt-mouse.el (xterm-mouse--read-number-from-terminal): Fix last commit.
+
+2015-03-25 Nicolas Petton <nicolas@petton.fr>
+
+ * emacs-lisp/seq.el: Documentation improvements.
+
+2015-03-25 Glenn Morris <rgm@gnu.org>
+
+ * net/browse-url.el (browse-url-browser-function)
+ (browse-url-default-browser):
+ Remove obsolete items from the explicit listing.
+ (browse-url-new-window-flag, browse-url-of-file-hook): Doc fixes.
+ (browse-url-netscape-program, browse-url-netscape-arguments)
+ (browse-url-netscape-startup-arguments)
+ (browse-url-galeon-program, browse-url-galeon-arguments)
+ (browse-url-galeon-startup-arguments)
+ (browse-url-gnome-moz-program, browse-url-gnome-moz-arguments)
+ (browse-url-galeon-new-window-is-tab)
+ (browse-url-netscape-new-window-is-tab)
+ (browse-url-mosaic-program, browse-url-mosaic-arguments)
+ (browse-url-mosaic-pidfile, browse-url-CCI-port)
+ (browse-url-CCI-host, browse-url-netscape-version)
+ (browse-url-netscape, browse-url-netscape-sentinel)
+ (browse-url-netscape-reload, browse-url-netscape-send)
+ (browse-url-galeon, browse-url-galeon-sentinel)
+ (browse-url-gnome-moz, browse-url-mosaic, browse-url-cci)
+ (browse-url-w3-gnudoit): Make obsolete.
+ * ffap.el (ffap-url-fetcher): Simplify default and doc.
+
+2015-03-25 Olaf Rogalsky <olaf.rogalsky@gmail.com>
+
+ * xt-mouse.el: Add mouse-tracking support (bug#19416).
+ (xterm-mouse-translate-1): Handle mouse-movement events.
+ (xterm-mouse--read-event-sequence-1000)
+ (xterm-mouse--read-event-sequence-1006): Delete functions.
+ (xterm-mouse--read-event-sequence): New function that handles both at
+ the same time. Handle mouse-movements.
+ (xterm-mouse--read-utf8-char, xterm-mouse--read-number-from-terminal):
+ New functions.
+ (xterm-mouse-event): Simplify.
+ (xterm-mouse-tracking-enable-sequence)
+ (xterm-mouse-tracking-disable-sequence): Enable mouse tracking.
+
+ * mouse.el (mouse-drag-line): Also ignore `vertical-line' prefix events.
+
+2015-03-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-do-file-attributes-with-ls)
+ (tramp-do-file-attributes-with-stat): Quote file names in output.
+ (tramp-do-directory-files-and-attributes-with-stat): Use "//" as marker.
+
+2015-03-24 Daiki Ueno <ueno@gnu.org>
+
+ * epg.el (epg-start-generate-key): Fix typo in "gpg --gen-key"
+ invocation; make the PARAMETERS documentation clearer.
+
+2015-03-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Add cl-struct specific optimizations to pcase.
+ * emacs-lisp/cl-macs.el (cl--struct-all-parents)
+ (cl--pcase-mutually-exclusive-p): New functions.
+ (pcase--mutually-exclusive-p): Advise to optimize cl-struct patterns.
+
+ * emacs-lisp/pcase.el (pcase--split-pred): Handle quoted string.
+
+2015-03-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Add new `cl-struct' and `eieio' pcase patterns.
+ * emacs-lisp/cl-macs.el (cl-struct): New pcase pattern.
+ * emacs-lisp/eieio.el (eieio-pcase-slot-index-table)
+ (eieio-pcase-slot-index-from-index-table): New functions.
+ (eieio): New pcase pattern.
+ * emacs-lisp/pcase.el (pcase--make-docstring): New function.
+ (pcase): Use it to build the docstring.
+ (pcase-defmacro): Make sure the macro is lazy-loaded.
+ (\`): Move its docstring from `pcase'.
+
+2015-03-23 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-aliases)
+ (authors-obsolete-files-regexps): Additions.
+
+2015-03-23 Jan Djärv <jan.h.d@swipnet.se>
+
+ * simple.el (deactivate-mark): Only modify PRIMARY if we own
+ PRIMARY (Bug#18939).
+
+2015-03-23 Martin Rudalics <rudalics@gmx.at>
+
+ * emacs-lisp/debug.el (debug): Don't try using "previous" window
+ when its not live or on an invisible frame (Bug#17170).
+
+2015-03-23 Dmitry Gutov <dgutov@yandex.ru>
+
+ * json.el (json-decode-char0): Delete this alias as well.
+ (json-read-escaped-char): Don't call it (bug#20154).
+
+2015-03-23 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/lisp-mode.el (lisp--el-non-funcall-position-p): New function.
+ (lisp--el-match-keyword): Use it.
+
+2015-03-23 Daiki Ueno <ueno@gnu.org>
+
+ * subr.el (start-process): New function, ported from the C
+ implementation.
+
+2015-03-23 Daniel Colascione <dancol@dancol.org>
+
+ Automatically adjust process window sizes.
+
+ * window.el (window-adjust-process-window-size-function):
+ New customizable variable.
+ (window-adjust-process-window-size)
+ (window-adjust-process-window-size-smallest)
+ (window-adjust-process-window-size-largest)
+ (window--process-window-list, window--adjust-process-windows):
+ New functions.
+ (window-configuration-change-hook):
+ Add `window--adjust-process-windows'.
+ * term.el (term-mode): Observe result of
+ `window-adjust-process-window-size-function'.
+ (term-check-size): Delete.
+
+2015-03-22 Jackson Ray Hamilton <jackson@jacksonrayhamilton.com>
+
+ * textmodes/sgml-mode.el (sgml-attribute-offset): New defcustom.
+ (sgml-calculate-indent): Use `sgml-attribute-offset' for attribute
+ indentation (bug#20161).
+
+2015-03-22 Dmitry Gutov <dgutov@yandex.ru>
+
+ * json.el (json-encode-char0): Delete this alias.
+ (json-encode-string): Rewrite to improve performance (bug#20154).
+ (json-encode-char): Fold into `json-encode-string'.
+
+2015-03-22 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * menu-bar.el (menu-bar-update-buffers): Count displayed buffers
+ for `buffers-menu-max-size', not total buffers.
+
+2015-03-21 Titus von der Malsburg <malsburg@posteo.de>
+
+ * window.el (window-font-width, window-font-height)
+ (window-max-chars-per-line): New functions.
+
+ * simple.el (default-font-height): Doc fix.
+ (default-font-width): New function.
+
+2015-03-21 Tassilo Horn <tsdh@gnu.org>
+
+ * emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-1):
+ Also recognize (cl-)defmethod with (setf method) name.
+
+2015-03-20 Tassilo Horn <tsdh@gnu.org>
+
+ * emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-1):
+ Fix false positive in function name font-locking.
+ (lisp-cl-font-lock-keywords-1): Ditto.
+
+2015-03-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-defsubst): Ignore false-positive
+ occurrences of args via &cl-defs (bug#20149).
+
+2015-03-20 Alan Mackenzie <acm@muc.de>
+
+ Fix debbugs#20146
+
+ * font-lock.el (font-lock-extend-jit-lock-region-after-change):
+ Return the calculated values, as per spec.
+
+2015-03-20 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): Move `at_exit'
+ and `callcc' to the "methods with required arguments" section,
+ they need a block argument. Remove a `throw' duplicate.
+
+2015-03-19 Vibhav Pant <vibhavp@gmail.com>
+
+ * progmodes/cperl-mode.el (cperl-electric-backspace):
+ Call delete-backward-space interactively instead of delete-char.
+
+2015-03-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pcase.el (pcase-lambda): Rewrite.
+
+ * emacs-lisp/eieio.el (object-slots): Return slot names as before
+ (bug#20141).
+
+2015-03-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ EIEIO: Change class's representation to unify instance and class slots
+ * emacs-lisp/eieio-core.el (eieio--class): Change field names and order
+ to match those of cl--class; use cl--slot for both instance slots and
+ class slots.
+ (eieio--object-num-slots): Use cl-struct-slot-info.
+ (eieio--object-class): Rename from eieio--object-class-object.
+ (eieio--object-class-name): Remove.
+ (eieio-defclass-internal): Adjust to new slot representation.
+ Store doc in class rather than in `variable-documentation'.
+ (eieio--perform-slot-validation-for-default): Change API to take
+ a slot object.
+ (eieio--slot-override): New function.
+ (eieio--add-new-slot): Rewrite.
+ (eieio-copy-parents-into-subclass): Rewrite.
+ (eieio--validate-slot-value, eieio--validate-class-slot-value)
+ (eieio-oref-default, eieio-oset-default)
+ (eieio--class-slot-name-index, eieio-set-defaults): Adjust to new
+ slot representation.
+ (eieio--c3-merge-lists): Simplify.
+ (eieio--class/struct-parents): New function.
+ (eieio--class-precedence-bfs): Use it.
+
+ * emacs-lisp/eieio.el (with-slots): Use macroexp-let2.
+ (object-class-fast): Change recommend replacement.
+ (eieio-object-class): Rewrite.
+ (slot-exists-p): Adjust to new slot representation.
+ (initialize-instance): Adjust to new slot representation.
+ (object-write): Adjust to new slot representation.
+
+ * emacs-lisp/eieio-opt.el (eieio--help-print-slot): New function
+ extracted from eieio-help-class-slots.
+ (eieio-help-class-slots): Use it. Adjust to new slot representation.
+
+ * emacs-lisp/eieio-datadebug.el (data-debug/eieio-insert-slots):
+ Declare to silence warnings.
+ (data-debug-insert-object-button): Avoid `object-slots'.
+ (data-debug/eieio-insert-slots): Adjust to new slot representation.
+
+ * emacs-lisp/eieio-custom.el (eieio-object-value-create)
+ (eieio-object-value-get): Adjust to new slot representation.
+
+ * emacs-lisp/eieio-compat.el
+ (eieio--generic-static-symbol-specializers):
+ Extract from eieio--generic-static-symbol-generalizer.
+ (eieio--generic-static-symbol-generalizer): Use it.
+
+ * emacs-lisp/eieio-base.el (eieio-persistent-convert-list-to-object):
+ Manually map initargs to slot names.
+ (eieio-persistent-validate/fix-slot-value): Adjust to new
+ slot representation.
+
+ * emacs-lisp/cl-preloaded.el (cl--class): Fix type of `parents'.
+
+2015-03-19 Vibhav Pant <vibhavp@gmail.com>
+
+ * leim/quail/hangul.el (hangul-delete-backward-char)
+ (hangul-to-hanja-conversion):
+ * progmodes/cperl-mode.el (cperl-electric-keyword)
+ (cperl-electric-backspace): Use delete-char instead of
+ delete-backward-char, fixes compilation warnings.
+
+2015-03-18 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-do-directory-files-and-attributes-with-stat):
+ Mark apostrophs with ?/ instead of \037. (Bug#20117)
+
+2015-03-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Add classes as run-time descriptors of cl-structs.
+ * emacs-lisp/cl-preloaded.el (cl--struct-get-class): New function.
+ (cl--make-slot-desc): New constructor.
+ (cl--plist-remove, cl--struct-register-child): New functions.
+ (cl-struct-define): Rewrite.
+ (cl-structure-class, cl-structure-object, cl-slot-descriptor)
+ (cl--class): New structs.
+ (cl--struct-default-parent): Initialize it here.
+ * emacs-lisp/cl-macs.el (cl--find-class): New macro.
+ (cl-defsubst, cl--defsubst-expand, cl--sublis): Move before first use.
+ (cl--struct-default-parent): New var.
+ (cl-defstruct): Adjust to new representation of classes; add
+ default parent. In accessors, signal `wrong-type-argument' rather than
+ a generic error.
+ (cl-struct-sequence-type, cl-struct-slot-info)
+ (cl-struct-slot-offset): Rewrite.
+ * emacs-lisp/cl-generic.el (cl--generic-struct-specializers)
+ (cl-generic-generalizers): Rewrite.
+
+ * emacs-lisp/macroexp.el (macroexp--debug-eager): New var.
+ (internal-macroexpand-for-load): Use it.
+
+ * emacs-lisp/debug.el (debug--implement-debug-on-entry):
+ Bind inhibit-debug-on-entry here...
+ (debug): Instead of here.
+
+2015-03-18 Dima Kogan <dima@secretsauce.net>
+
+ Have gud-display-line not display source buffer in gud window.
+ * progmodes/gud.el (gud-display-line): Make display-buffer
+ not reuse selected window. (Bug#17675, Bug#19901, Bug#20034)
+
+2015-03-17 Tassilo Horn <tsdh@gnu.org>
+
+ * emacs-lisp/byte-run.el (macro-declarations-alist):
+ New declaration no-font-lock-keyword.
+ (defmacro): Flush font-lock in existing elisp buffers.
+
+ * emacs-lisp/lisp-mode.el (lisp--el-update-after-load)
+ (lisp--el-update-macro-regexp, lisp--el-macro-regexp):
+ Delete functions and defconst.
+ (lisp--el-match-keyword): Rename from lisp--el-match-macro.
+ (lisp--el-font-lock-flush-elisp-buffers): New function.
+ (lisp-mode-variables): Remove code for updating
+ lisp--el-macro-regexp, and add
+ lisp--el-font-lock-flush-elisp-buffers to after-load-functions.
+
+2015-03-17 Simen Heggestøyl <simenheg@gmail.com>
+
+ * textmodes/css-mode.el (css--font-lock-keywords):
+ Discriminate between pseudo-classes and pseudo-elements.
+ (css-pseudo-ids): Remove.
+ (css-pseudo-class-ids, css-pseudo-element-ids): New variables.
+ (css--complete-property): New function for completing CSS properties.
+ (css--complete-pseudo-element-or-class): New function
+ completing CSS pseudo-elements and pseudo-classes.
+ (css--complete-at-rule): New function for completing CSS at-rules.
+ (css-completion-at-point): New function.
+ (css-mode): Add support for completion.
+ (css-extract-keyword-list, css-extract-parse-val-grammar)
+ (css-extract-props-and-vals): Remove function in favor of manual
+ extraction.
+ (css-at-ids): Update list of CSS at-rule ids.
+ (css-property-ids): Update list of CSS properties.
+
+2015-03-17 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): Font-lock
+ more Kernel methods.
+
+2015-03-17 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-maybe-send-script): Avoid leading tabs in
+ shell scripts. (Bug#20118)
+
+2015-03-17 Eli Zaretskii <eliz@gnu.org>
+
+ * mouse.el (mouse-appearance-menu): If w32-use-w32-font-dialog is
+ nil, construct a menu of fixed fonts. This resurrects a feature
+ lost in Emacs 23.
+
+ * w32-vars.el (w32-use-w32-font-dialog): Add a ':set' function to
+ reset mouse-appearance-menu-map, so the font dialog is recomputed
+ the next time the menu is requested.
+ (w32-fixed-font-alist): Fix to use correct names of Courier fonts.
+
+2015-03-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl--transform-lambda): Refine last change
+ (bug#20125).
+
+2015-03-17 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-ssh-controlmaster-options): Change test
+ for ControlPath in order to avoid DNS timeouts. (Bug#20015)
+
+2015-03-16 Alan Mackenzie <acm@muc.de>
+
+ Edebug: Allow "S" to work during trace mode. Fixes debbugs #20074.
+ Also display the overlay arrow in go and go-nonstop modes.
+
+ * emacs-lisp/edebug.el (edebug--display-1): Move the
+ `input-pending' test to after trace mode's `sit-for'.
+ (edebug--recursive-edit): Insert "(sit-for 0)" after
+ "(edebug-overlay-arrow)".
+
+2015-03-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl--transform-lambda): Rework to avoid
+ cl--do-arglist in more cases; add comments to explain what's going on.
+ (cl--do-&aux): New function extracted from cl--do-arglist.
+ (cl--do-arglist): Use it.
+
+ * emacs-lisp/cl-generic.el: Add Version: header, for ELPA purposes.
+
+ * obsolete/iswitchb.el (iswitchb-read-buffer): Add `predicate' arg.
+ * isearchb.el (isearchb-iswitchb): Adjust accordingly.
+ * ido.el (ido-read-buffer): Add `predicate' argument.
+ * misearch.el (unload-function-defs-list): Declare before use.
+
+2015-03-16 Vibhav Pant <vibhavp@gmail.com>
+
+ * net/browse-url.el (browse-url-browser-function): Add "Conkeror".
+ (browse-url-conkeror-program, browse-url-conkeror-arguments)
+ (browse-url-conkeror-new-window-is-buffer): New defcustoms.
+ (browse-url-default-browser): Check for `browse-url-conkeror'
+ and call `browse-url-conkeror-program'.
+ (browse-url-conkeror): New command.
+ (bug#19863)
+
+2015-03-16 Vibhav Pant <vibhavp@gmail.com>
+
+ * eshell/esh-mode.el (eshell/clear): New function.
+
+2015-03-16 Alan Mackenzie <acm@muc.de>
+
+ Make Edebug work with Follow Mode.
+
+ * emacs-lisp/edebug.el (edebug--display-1): Remove call to
+ edebug-adjust-window.
+ (edebug--recursive-edit): Don't bind pre/post-command-hooks to nil
+ over the recursive edit.
+ (edebug-adjust-window): Remove.
+
+2015-03-15 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-adb.el:
+ * net/tramp-gvfs.el:
+ * net/tramp-sh.el:
+ * net/tramp-smb.el: Set tramp-autoload cookie for all defcustoms.
+
+ * net/tramp.el (tramp-ssh-controlmaster-options)
+ (tramp-use-ssh-controlmaster-options): Move them to tramp-sh.el.
+ (tramp-default-method): Do not check for
+ `tramp-ssh-controlmaster-options'.
+
+ * net/tramp-sh.el (tramp-use-ssh-controlmaster-options):
+ New defcustom, moved from tramp.el.
+ (tramp-ssh-controlmaster-options): New defvar, moved from tramp.el
+ but with a nil initial value.
+ (tramp-ssh-controlmaster-options): New defun.
+ (tramp-do-copy-or-rename-file-out-of-band)
+ (tramp-maybe-open-connection): Use it. (Bug#20015)
+
+2015-03-15 Tassilo Horn <tsdh@gnu.org>
+
+ * emacs-lisp/lisp-mode.el (lisp--el-macro-regexp): New defconst.
+ (lisp--el-update-macro-regexp, lisp--el-update-after-load)
+ (lisp--el-match-macro): New functions.
+ (lisp-mode-variables): Update lisp--el-macro-regexp and add
+ lisp--el-update-after-load to after-load-functions.
+
+2015-03-15 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/cl-indent.el
+ (lisp-indent-backquote-substitution-mode): New user option.
+ (common-lisp-indent-function-1, common-lisp-loop-part-indentation)
+ (common-lisp-indent-function): Support normally indenting
+ backquote substitutions.
+ (extended-loop-p): Rename to `lisp-extended-loop-p'.
+
+2015-03-14 Michael R. Mauger <michael@mauger.com>
+
+ * progmodes/sql.el: Version 3.5
+ (sql-starts-with-prompt-re, sql-ends-with-prompt-re): Match password prompts.
+ (sql-interactive-remove-continuation-prompt): Fix regression. (Bug#6686)
+
+2015-03-14 Daniel Colascione <dancol@dancol.org>
+
+ * widget.el (define-widget): Check that documentation is a string
+ or nil; prevent wailing and gnashing of teeth when users forget to
+ pass a docstring and wonder why their properties don't work.
+
+ * startup.el (command-line): Process "--no-x-resources".
+
+2015-03-13 Kevin Ryde <user42_kevin@yahoo.com.au>
+
+ info-look fixes for Texinfo 5
+ * info-look.el (c-mode, bison-mode, makefile-mode)
+ (makefile-automake-mode, texinfo-mode, autoconf-mode, awk-mode)
+ (latex-mode, emacs-lisp-mode, sh-mode, cfengine-mode):
+ Match `foo' and 'foo' and ‘foo’ for @item and similar.
+ (latex-mode): Match multi-arg \frac{num}{den} or \sqrt[root]{n} in
+ suffix regexp.
+
+2015-03-12 Juri Linkov <juri@linkov.net>
+
+ * simple.el (next-line-or-history-element)
+ (previous-line-or-history-element): Remember the goal column of
+ possibly multi-line input, and restore it afterwards. (Bug#19824)
+
+2015-03-12 Rasmus Pank Roulund <emacs@pank.eu>
+
+ * ido.el (ido-add-virtual-buffers-to-list): Include bookmark-alist
+ files (bug#19335).
+
+2015-03-12 Eli Zaretskii <eliz@gnu.org>
+
+ * international/fontset.el (script-representative-chars): Add a
+ representative character for 'vai'.
+
+2015-03-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * international/quail.el (quail-input-method):
+ Use with-silent-modifications.
+
+ * simple.el (goto-history-element): Don't burp on t history.
+
+2015-03-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer "initialize" to "initialise"
+ * progmodes/js.el (js-indent-first-init):
+ Rename from js-indent-first-initialiser, to avoid worrying about
+ American vs British spelling. All uses changed.
+
+2015-03-10 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/js.el (js-indent-first-initialiser):
+ Fix doc, type, version.
+
+2015-03-10 Jackson Ray Hamilton <jackson@jacksonrayhamilton.com>
+
+ * progmodes/js.el (js-indent-first-initialiser): New option.
+ (js--maybe-goto-declaration-keyword-end): New function.
+ (js--proper-indentation): Use js--maybe-goto-declaration-keyword-end.
+
+2015-03-10 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/ldap.el (ldap-attribute-syntaxes-alist): Add LDAP attributes
+ from RFC2798 Section 9.1.1. (Bug#8983)
+
+2015-03-09 Nicolas Petton <nicolas@petton.fr>
+
+ * emacs-lisp/seq.el (seq-into): New function.
+ Bump seq.el version to 1.3.
+
+2015-03-09 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): Don't consider
+ `=' a part of symbol when followed by `>'. (Bug#18644)
+ (ruby-syntax-before-regexp-re): Detect regexps after `!'.
+ (Bug#19285)
+
+2015-03-09 Eli Zaretskii <eliz@gnu.org>
+
+ * dired.el (dired-delete-file): Doc fix. (Bug#20021)
+
+2015-03-06 Sergio Durigan Junior <sergiodj@sergiodj.net>
+ Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/eudcb-bbdb.el (eudc-bbdb-field): New function.
+ (eudc-bbdb-filter-non-matching-record): Call eudc-bbdb-field.
+ (eudc-bbdb-format-record-as-result): Likewise.
+
+2015-03-08 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords):
+ Use `font-lock-constant-face' for nil, true and false.
+ Highlight `self' as a keyword. (Bug#17733)
+
+2015-03-08 Nobuyoshi Nakada <nobu@ruby-lang.org>
+
+ * progmodes/ruby-mode.el (ruby-syntax-before-regexp-re):
+ Expect beginning of regexp also after open brace or vertical bar.
+ (Bug#20026)
+
+2015-03-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * battery.el (battery-echo-area-format): Simplify default.
+ (battery-linux-sysfs): Standardize on energy&power. Accept ADP1
+ for AC adapter.
+
+ * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't try to
+ unfold `closure's since byte-compile-unfold-lambda doesn't know how to
+ do it.
+
+2015-03-06 Oscar Fuentes <ofv@wanadoo.es>
+
+ * net/browse-url.el (browse-url-firefox): Remove outdated
+ MS-Windows limitations.
+
+2015-03-06 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/eudcb-ldap.el (eudc-ldap-cleanup-record-simple): Mark as
+ obsolete.
+ (eudc-ldap-cleanup-record-filtering-addresses): Add docstring.
+ Don't clean up postal addresses if ldap-ignore-attribute-codings
+ is set. Combine mail addresses into one field. (Bug#17720)
+ (eudc-ldap-simple-query-internal):
+ Call eudc-ldap-cleanup-record-filtering-addresses instead of
+ eudc-ldap-cleanup-record-simple.
+ (eudc-ldap-get-field-list): Likewise.
+
+2015-03-05 Ivan Shmakov <ivan@siamics.net>
+
+ * net/eww.el (eww-html-p): New function (bug#20009).
+ (eww-render): Use it.
+
+2015-03-05 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * desktop.el (desktop-buffer-info): Write docstring.
+ (desktop-buffer-info): Use `pushnew' instead of `add-to-list' and
+ unquote lamda.
+
+ * emacs-lisp/package.el (package-refresh-contents): Update doc.
+
+2015-03-05 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/js.el (js-mode-syntax-table): Add an entry for `.
+
+2015-03-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Replace *-function vars with generic functions in cl-generic.
+ * emacs-lisp/cl-generic.el (cl--generic-generalizer): New struct.
+ (cl-generic-tagcode-function, cl-generic-tag-types-function): Remove.
+ (cl--generic-t-generalizer): New const.
+ (cl--generic-make-method): Rename from `cl--generic-method-make'.
+ (cl--generic-make): Change calling convention.
+ (cl--generic): Add `options' field.
+ (cl-generic-function-options): New function.
+ (cl-defgeneric): Rewrite handling of options. Add support for :method
+ options and allow the use of a default body.
+ (cl-generic-define): Save options in the corresponding new field.
+ (cl-defmethod): Fix ordering of qualifiers.
+ (cl-generic-define-method): Use cl-generic-generalizers.
+ (cl--generic-get-dispatcher): Change calling convention, and change
+ calling convention of the returned function as well so as to take the
+ list of methods separately from the generic function object, so that it
+ can receive the original generic function object.
+ (cl--generic-make-next-function): New function, extracted from
+ cl--generic-make-function.
+ (cl--generic-make-function): Use it.
+ (cl-generic-method-combination-function): Remove.
+ (cl--generic-cyclic-definition): New error.
+ (cl-generic-call-method): Take a generic function object rather than
+ its name.
+ (cl-method-qualifiers): New alias.
+ (cl--generic-build-combined-method): Use cl-generic-combine-methods,
+ don't segregate by qualifiers here any more.
+ (cl--generic-standard-method-combination): Segregate by qualifiers
+ here instead. Add support for the `:extra' qualifier.
+ (cl--generic-cache-miss): Move earlier, adjust to new calling convention.
+ (cl-generic-generalizers, cl-generic-combine-methods):
+ New generic functions.
+ (cl-no-next-method, cl-no-applicable-method, cl-no-primary-method):
+ Use the new "default method in defgeneric" functionality, change
+ calling convention to receive a generic function object.
+ (cl--generic-head-used): New var.
+ (cl--generic-head-generalizer, cl--generic-eql-generalizer)
+ (cl--generic-struct-generalizer, cl--generic-typeof-generalizer):
+ New consts.
+ * emacs-lisp/eieio-core.el (eieio--generic-generalizer)
+ (eieio--generic-subclass-generalizer): New consts.
+ (cl-generic-generalizers): New methods.
+ * emacs-lisp/eieio-compat.el (eieio--generic-static-symbol-generalizer)
+ (eieio--generic-static-object-generalizer): New consts.
+ (cl-generic-generalizers) <(head eieio--static)>: New method.
+ * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker):
+ Unfold closures like lambdas.
+
+2015-03-04 Filipp Gunbin <fgunbin@fastmail.fm>
+
+ * autorevert.el (auto-revert-notify-add-watch):
+ Fix handler installation. (Bug#20000)
+
+2015-03-04 Rüdiger Sonderfeld <ruediger@c-plusplus.net>
+
+ * net/eww.el (eww-search-prefix, eww-open-file, eww-search-words)
+ (eww-same-page-p,eww-set-character-encoding): Fix docstring.
+ (eww): Do not end error messages with a period.
+
+2015-03-04 Zhongwei Yao <ashi08104@gmail.com>
+
+ * net/tramp-adb.el (tramp-adb-connect-if-not-connected):
+ New user option.
+ (tramp-adb-ls-toolbox-regexp): Fix regexp in order to support file
+ names starting with a space.
+ (tramp-methods): Add `tramp-default-port' for "adb".
+ (tramp-adb-parse-device-names): Add traces. Return device names
+ with port, if present.
+ (tramp-adb-handle-directory-files-and-attributes): Quote all
+ remote file names.
+ (tramp-adb-get-device): New defun.
+ (tramp-adb-execute-adb-command, tramp-adb-maybe-open-connection):
+ Use it.
+ (tramp-adb-maybe-open-connection): Set `tramp-current-*'
+ variables. Remove checks for listed devices.
+
+2015-03-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp): Add :link property.
+ (tramp-login-prompt-regexp): Allow also "user", as required by
+ Fritz!Box telnet.
+ (tramp-autoload-file-name-handler): Use "/".
+ (tramp-handle-unhandled-file-name-directory): Return nil when
+ required by the spec.
+
+ * net/tramp-cache.el (tramp-dump-connection-properties):
+ Use `with-temp-file'.
+
+ * net/tramp-sh.el (tramp-perl-file-attributes)
+ (tramp-perl-directory-files-and-attributes): Escape apostrophes in
+ file names.
+ (tramp-do-file-attributes-with-stat): Quote file name.
+ (tramp-sh-handle-directory-files-and-attributes): Fall back to
+ `tramp-handle-directory-files-and-attributes' in case of problems.
+ (tramp-do-directory-files-and-attributes-with-stat)
+ (tramp-sh-handle-file-name-all-completions)
+ (tramp-sh-handle-delete-directory)
+ (tramp-sh-handle-expand-file-name, tramp-sh-handle-process-file):
+ Normalize use of "cd".
+ (tramp-do-directory-files-and-attributes-with-stat): Use the
+ `quoting-style' arg of `ls' if possible. Make it also working for
+ file names with apostrophes.
+ (tramp-sh-handle-file-name-all-completions): Use arguments of `ls'
+ in proper order.
+ (tramp-do-copy-or-rename-file-via-buffer)
+ (tramp-sh-handle-file-local-copy): Use `with-temp-file'.
+ (tramp-get-remote-locale): Accept also \r in output.
+ (tramp-get-ls-command-with-quoting-style): New defun.
+ (tramp-get-inline-coding): Set `default-directory' to a local
+ directory. Sporadically, `call-process-region' does not handle a
+ remote default directory properly.
+
+ * net/trampver.el: Update release number.
+
+2015-03-03 Agustín Martín Domingo <agustin6martin@gmail.com>
+
+ * textmodes/ispell.el (ispell-aspell-find-dictionary): Make sure
+ .dat files for aspell dicts are also searched for in location
+ described by `ispell-aspell-dict-dir', matching aspell's dict-dir
+ variable.
+
+2015-03-03 Agustín Martín Domingo <agustin6martin@gmail.com>
+
+ * textmodes/ispell.el (ispell-dicts-name2locale-equivs-alist)
+ (ispell-hunspell-fill-dictionary-entry)
+ (ispell-find-hunspell-dictionaries)
+ (ispell-set-spellchecker-params): New generic name for
+ `ispell-hunspell-dictionary-equivs-alist'.
+ (ispell-aspell-add-aliases): Also use
+ `ispell-dicts-name2locale-equivs-alist' to get aspell aliases for
+ standard dict names.
+
+2015-03-03 Glenn Morris <rgm@gnu.org>
+
+ * net/browse-url.el (browse-url-firefox-startup-arguments):
+ Make obsolete.
+ (browse-url-firefox): Doc fix. Remove -remote, which no longer
+ exists in Firefox 36. (Bug#19921)
+ (browse-url-firefox-sentinel): Remove function.
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * frame.el (blink-cursor-timer-function): Don't increment
+ blink-cursor-blinks-done counter when a menu is active on a w32
+ frame. (Bug#19925)
+
+2015-03-03 Juri Linkov <juri@linkov.net>
+
+ * comint.el (comint-line-beginning-position): Revert searching for
+ the prompt when comint-use-prompt-regexp is non-nil because it
+ doesn't distinguish input from output. Check the field property
+ `output' for the case when comint-use-prompt-regexp is nil.
+ (Bug#19710)
+
+2015-03-03 Jérémy Compostella <jeremy.compostella@gmail.com>
+
+ * net/tramp-sh.el (tramp-remote-process-environment): Disable paging
+ with PAGER=cat. (Bug#19870)
+
+2015-03-03 Glenn Morris <rgm@gnu.org>
+
+ * textmodes/flyspell.el (flyspell-duplicate-distance):
+ Bump :version.
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * textmodes/text-mode.el (text-mode-syntax-table): Make some
+ punctuation character behave as word-constituent, for more
+ compatibility with Unicode.
+
+ * simple.el (transient-mark-mode): Doc fix. (Bug#19841)
+
+2015-03-03 Agustín Martín Domingo <agustin6martin@gmail.com>
+
+ Improve string search in `flyspell-word-search-*`. (Bug#16800)
+ * textmodes/flyspell.el (flyspell-duplicate-distance):
+ Limit default search distance for duplicated words to 40000.
+ (flyspell-word-search-backward, flyspell-word-search-forward):
+ Search as full word with defined casechars, not as substring.
+
+2015-03-03 Juri Linkov <juri@linkov.net>
+
+ Better support for the case of typing RET on the prompt in comint.
+ * comint.el (comint-get-old-input-default): Go to the field end
+ when comint-use-prompt-regexp is nil.
+ (comint-line-beginning-position): Check if point is already
+ on the prompt before searching for the prompt when
+ comint-use-prompt-regexp is non-nil. (Bug#19710)
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * frame.el (frame-notice-user-settings): Refresh the value of
+ frame parameters after calling tty-handle-reverse-video.
+ Call face-set-after-frame-default with the actual parameters, to avoid
+ resetting colors back to unspecified.
+ (set-background-color, set-foreground-color): Pass the foreground
+ and background colors to face-set-after-frame-default. (Bug#19802)
+
+2015-03-03 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * net/network-stream.el (network-stream-open-tls): Respect the
+ :end-of-capability setting.
+
+2015-03-03 Juri Linkov <juri@linkov.net>
+
+ Revert the previous change of comint-line-beginning-position callers,
+ and modify comint-line-beginning-position instead.
+
+ * comint.el (comint-history-isearch-search)
+ (comint-history-isearch-message, comint-history-isearch-wrap):
+ Use comint-line-beginning-position instead of field-beginning.
+ (comint-send-input): Use either end-of-line or field-end
+ depending on comint-use-prompt-regexp.
+ (comint-line-beginning-position): Search backward
+ for comint-prompt-regexp if comint-use-prompt-regexp is non-nil.
+ Use field-beginning instead of line-beginning-position
+ if comint-use-prompt-regexp is nil. (Bug#19710)
+
+2015-03-03 Robert Pluim <rpluim@gmail.com> (tiny change)
+
+ * calendar/todo-mode.el (todo-item-done): When done items are
+ hidden, restore point to its location prior to invoking this
+ command. (Bug#19727)
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * textmodes/artist.el (artist-ellipse-compute-fill-info):
+ Use mapcar, not mapc, to create the other half of fill-info.
+ (Bug#19763)
+
+2015-03-03 Nicolas Petton <nicolas@petton.fr>
+
+ * emacs-lisp/authors.el (authors-ignored-files)
+ (authors-renamed-files-alist): Additions.
+
+2015-03-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-ssh-controlmaster-options): Don't use a
+ tempfile for ControlPath. (Bug#19702)
+
+2015-03-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-ssh-controlmaster-options): Use "%C" for
+ ControlPath if possible. (Bug#19702)
+
+2015-03-03 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-obsolete-files-regexps)
+ (authors-valid-file-names, authors-renamed-files-alist): Additions.
+
+2015-03-03 Alan Mackenzie <acm@muc.de>
+
+ CC Mode: Stop Font Lock forcing fontification from BOL. (Bug#19669)
+ * progmodes/cc-mode.el (c-font-lock-init):
+ Set font-lock-extend-region-functions to nil.
+
+2015-03-03 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/generator.el: Make globals conform to elisp
+ style throughout. Use more efficient font-lock patterns.
+ (cps-inhibit-atomic-optimization): Rename from
+ `cps-disable-atomic-optimization'.
+ (cps--gensym): New macro; replaces `cl-gensym' throughout.
+ (cps-generate-evaluator): Move the `iter-yield' local macro
+ definition here
+ (iter-defun, iter-lambda): from here.
+
+ (iter-defun): Use `macroexp-parse-body'.
+
+2015-03-03 Daniel Colascione <dancol@dancol.org>
+
+2015-03-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/gud.el: Use lexical-binding (bug#19966).
+
+ * emacs-lisp/gv.el (gv-ref): Warn about likely problematic cases.
+
+2015-03-03 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/generator.el: Make globals conform to elisp
+ style throughout. Use more efficient font-lock patterns.
+ (cps-inhibit-atomic-optimization): Rename from
+ `cps-disable-atomic-optimization'.
+ (cps--gensym): New macro; replaces `cl-gensym' throughout.
+ (cps-generate-evaluator): Move the `iter-yield' local macro
+ definition here...
+ (iter-defun, iter-lambda): ...from here.
+
+2015-03-03 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package-autoremove): Fix if logic.
+
+2015-03-03 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window--dump-frame): For pixel height return total
+ number of frame's lines.
+
+2015-03-03 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/cl-macs.el (cl-iter-defun): Add cl-iter-defun.
+
+ * emacs-lisp/generator.el (iter-defun): Correctly propagate
+ docstrings and declarations to underlying function.
+
+2015-03-02 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/generator.el: New file.
+
+ * vc/vc.el (vc-responsible-backend): Add autoload cookie for
+ `vc-responsible-backend'.
+
+2015-03-01 Michael Albinus <michael.albinus@gmx.de>
+
+ * vc/vc-hooks.el (vc-state, vc-working-revision):
+ Use `vc-responsible-backend' in order to support unregistered files.
+
+ * vc/vc-rcs.el (vc-rcs-unregister): Support unregistered files.
+
+ * vc/vc-rcs.el (vc-rcs-fetch-master-state):
+ * vc/vc-sccs.el (vc-sccs-working-revision): Handle undefined
+ master name.
+
+ * vc/vc-src.el (vc-src-working-revision): Do not return an empty string.
+
+2015-03-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-insert): Remove soft hyphens.
+ (shr-insert): Also remove soft hypens from non-folded text.
+
+2015-02-28 Eli Zaretskii <eliz@gnu.org>
+
+ * mail/rmailmm.el (rmail-mime-insert-html): Decode HTML payload
+ when the charset is only given by the HTML <head>, and allow to
+ specify the encoding with "C-x RET c".
+
+2015-02-27 Mark Laws <mdl@60hz.org>
+
+ Support daemon mode on MS-Windows (bug#19688)
+ * server.el (server-process-filter): Force GUI frames on
+ MS-Windows in daemon mode, even if a TTY frame was requested.
+
+ * frameset.el (frameset-keep-original-display-p): Don't assume
+ windows-nt cannot be in daemon mode.
+
+ * frame.el (window-system-for-display): Don't assume windows-nt
+ cannot be in daemon mode.
+
+2015-02-26 Ivan Shmakov <ivan@siamics.net>
+
+ * faces.el (face-list-p): Split from face-at-point.
+ (face-at-point): Use it.
+ * facemenu.el (facemenu-add-face): Likewise. (Bug#19912)
+
+2015-02-26 Oscar Fuentes <ofv@wanadoo.es>
+
+ * vc/vc.el (vc-annotate-switches): New defcustom.
+ * vc/vc-bzr.el (vc-bzr-annotate-switches): New defcustom.
+ (vc-bzr-annotate-command): Use vc-switches.
+ * vc/vc-cvs.el (vc-cvs-annotate-switches): New defcustom.
+ (vc-cvs-annotate-command): Use vc-switches.
+ * vc/vc-git.el (vc-git-annotate-switches): New defcustom.
+ (vc-git-annotate-command): Use vc-switches.
+ * vc/vc-hg.el (vc-hg-annotate-switches): New defcustom.
+ (vc-hg-annotate-command): Use vc-switches.
+ * vc/vc-mtn.el (vc-mtn-annotate-switches): New defcustom.
+ (vc-mtn-annotate-command): Use vc-switches.
+ * vc/vc-svn.el (vc-svn-annotate-switches): New defcustom.
+ (vc-svn-annotate-command): Use vc-switches.
+
+2015-02-26 Alan Mackenzie <acm@muc.de>
+
+ Handle "#" operator properly inside macro. Fix coding bug.
+
+ * progmodes/cc-mode.el (c-neutralize-syntax-in-and-mark-CPP):
+ On finding a "#" which looks like the start of a macro, check it
+ isn't already inside a macro.
+
+ * progmodes/cc-engine.el (c-state-safe-place): Don't record a new
+ "safe" position into the list of them when this is beyond our
+ current position.
+
+2015-02-26 Martin Rudalics <rudalics@gmx.at>
+
+ * menu-bar.el (menu-bar-non-minibuffer-window-p): Return nil when
+ the menu frame is dead. (Bug#19728)
+
+2015-02-26 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Handle tabs in python-indent-dedent-line.
+ * progmodes/python.el (python-indent-dedent-line): Fixes for
+ indentation with tabs. Thanks to <dale@codefu.org> (Bug#19730).
+
+2015-02-26 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-indent-context): Respect user
+ indentation after comment.
+
+2015-02-26 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex-vars.el (featurep): Conditionalize value of
+ reftex-label-regexps in order to stay compatible with XEmacs 21.5
+ which has no explicitly numbered groups in regexps (bug#19714).
+
+2015-02-26 Daiki Ueno <ueno@gnu.org>
+
+ * net/dbus.el (dbus-register-signal): Convert "N" of ":argN" to
+ integer before comparison.
+
+2015-02-25 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ * progmodes/elisp-mode.el (elisp--eval-last-sexp): Document argument.
+
+2015-02-25 Oleh Krehel <ohwoeowho@gmail.com>
+
+ * emacs-lisp/check-declare.el (check-declare-warn):
+ Use compilation-style warnings.
+ (check-declare-files): Make sure that
+ `check-declare-warning-buffer' is in `compilation-mode'.
+
+2015-02-25 Oleh Krehel <ohwoeowho@gmail.com>
+
+ * emacs-lisp/check-declare.el (check-declare-ext-errors):
+ New defcustom.
+ (check-declare): New defgroup.
+ (check-declare-verify): When `check-declare-ext-errors' is
+ non-nil, warn about an unfound function, instead of saying
+ "skipping external file".
+
+2015-02-25 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex-vars.el (reftex-include-file-commands):
+ Call reftex-set-dirty on changes.
+
+2015-02-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/edebug.el (edebug--display): Save-excursion (bug#19611).
+ * emacs-lisp/debug.el (debugger-env-macro): Remove redundant
+ save-excursion.
+
+2015-02-24 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmailsum.el (rmail-summary-previous-all)
+ (rmail-summary-previous-msg): Simplify.
+
+2015-02-25 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * simple.el (region-active-p): Fix doc to say non-nil.
+
+2015-02-24 Samer Masterson <nosefrog@gmail.com>
+
+ * eshell/em-hist.el (eshell-hist-parse-word-designator):
+ Return args joined with " ".
+ * eshell/em-pred.el (eshell-parse-modifiers): Correct docstring.
+ (eshell-hist-parse-modifier): Pass mod a list instead of a string
+ (bug#18960).
+
+2015-02-24 Karl Fogel <kfogel@red-bean.com> (tiny change)
+
+ * comint.el (comint-mode-map): Fix obvious typo.
+
+2015-02-24 Johan Claesson <johanclaesson@bredband.net> (tiny change)
+
+ * filecache.el (file-cache-filter-regexps):
+ Add lock files. (Bug#19516)
+
+2015-02-24 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmailsum.el (rmail-summary-next-all)
+ (rmail-summary-previous-all, rmail-summary-next-msg):
+ Fix handling of optional argument. (Bug#19916)
+
+ * progmodes/f90.el (f90-beginning-of-subprogram)
+ (f90-end-of-subprogram, f90-match-end):
+ Handle continued strings where the continuation does not start
+ with "&" and happens to match our regexp. (Bug#19809)
+
+2015-02-24 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * comint.el (comint-clear-buffer): New command.
+ (comint-mode-map): Bind `comint-clear-buffer' to 'C-c M-o'.
+
+2015-02-23 Pete Williamson <petewil0@googlemail.com> (tiny change)
+
+ Use ${EXEEXT} more uniformly in makefiles
+ * Makefile.in (EMACS): Append ${EXEEXT}.
+
+2015-02-23 Sam Steingold <sds@gnu.org>
+
+ * files.el (recover-session): Handle `auto-save-list-file-prefix'
+ being a directory (empty non-directory part).
+
+2015-02-23 Magnus Henoch <magnus.henoch@gmail.com>
+
+ * net/sasl.el (sasl-mechanism-alist): Refer to sasl-scram-rfc
+ instead of sasl-scram-sha-1, as the former is the name that can be
+ required.
+
+ * net/sasl-scram-rfc.el (sasl-scram-sha-1-steps)
+ (sasl-scram-sha-1-client-final-message)
+ (sasl-scram-sha-1-authenticate-server): Move to end of file.
+
+2015-02-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ * bindings.el (ctl-x-map): Use [?\C-\;] to get the desired binding.
+ (Bug#19826)
+
+2015-02-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el (macroexp-parse-body): Handle cl-declare
+ and :documentation. Change return value format accordingly.
+ * emacs-lisp/cl-generic.el (cl--generic-lambda):
+ * emacs-lisp/pcase.el (pcase-lambda): Adjust accordingly.
+ * emacs-lisp/cl-macs.el (cl--transform-lambda): Use macroexp-parse-body.
+
+2015-02-23 Dmitry Gutov <dgutov@yandex.ru>
+
+ Introduce `xref-etags-mode'.
+ * progmodes/xref.el (xref-etags-mode--saved): New variable.
+ (xref-etags-mode): New minor mode. (Bug#19466)
+
+2015-02-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dom.el (dom-previous-sibling): New function.
+
+2015-02-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ * bindings.el (ctl-x-map): There is no 'C-;'.
+ For now, make do with 'M-;'; this allows 'make bootstrap' to work.
+ Perhaps some other binding should be chosen. (Bug#19826)
+
+2015-02-21 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * bindings.el (ctl-x-map): Fix `comment-line' binding. (Bug#19826)
+
+2015-02-21 Michael Albinus <michael.albinus@gmx.de>
+
+ * autorevert.el (auto-revert-notify-add-watch)
+ (auto-revert-notify-handler, auto-revert-buffers): Handle also
+ buffers without an associated file, like dired buffers. (Bug#16112)
+
+2015-02-21 Dima Kogan <dima@secretsauce.net>
+
+ * autorevert.el (auto-revert-mode, auto-revert-tail-mode)
+ (global-auto-revert-mode): Remove (let (auto-revert-use-notify) ... )
+ wrappers. Call (auto-revert-buffers) consequently in order to
+ install handlers.
+
+2015-02-21 Wilson Snyder <wsnyder@wsnyder.org>
+
+ Sync with upstream verilog-mode revision 0d6420b.
+ * progmodes/verilog-mode.el (verilog-mode-version): Update.
+ (vector-skip-list): Remove.
+ (verilog-auto-inst-port, verilog-auto-inst-port-list)
+ (verilog-auto-inst, verilog-auto-inst-param):
+ Use arguments rather than vector-skip.
+ (verilog-auto-inst-port): Fix AUTOINST interfaces to not show
+ modport if signal attachment is itself a modport.
+ Reported by Matthew Lovell.
+
+2015-02-21 Reto Zimmermann <reto@gnu.org>
+
+ Sync with upstream vhdl mode v3.37.1. Add VHDL'08 support.
+ * progmodes/vhdl-mode.el (vhdl-version, vhdl-time-stamp)
+ (vhdl-doc-release-notes): Update.
+ (vhdl-standard): Add VHDL'08 option.
+ (vhdl-sensitivity-list-all): New option.
+ (vhdl-directive-keywords): Add psl.
+ (vhdl-offsets-alist-default, vhdl-mode-abbrev-table-init)
+ (vhdl-template-construct-alist-init, vhdl-create-mode-menu):
+ (vhdl-imenu-generic-expression): Add context, directive.
+ (vhdl-offsets-alist, vhdl-mode, vhdl-doc-keywords): Doc fixes.
+ (vhdl-template-map-init): Add vhdl-template-context.
+ (vhdl-mode-syntax-table): Support VHDL'08 block comments.
+ (vhdl-create-mode-menu): Add some entries.
+ (vhdl-08-keywords, vhdl-08-types, vhdl-08-attributes)
+ (vhdl-08-functions, vhdl-08-packages, vhdl-08-directives):
+ New constants.
+ (vhdl-directives): New variable.
+ (vhdl-words-init, vhdl-template-process)
+ (vhdl-template-replace-header-keywords): Support VHDL'08.
+ (vhdl-abbrev-list-init): Add vhdl-directives.
+ (vhdl-in-comment-p, vhdl-in-literal, vhdl-win-il)
+ (vhdl-forward-syntactic-ws, vhdl-get-syntactic-context)
+ (vhdl-lineup-comment): Handle block comments and directives.
+ (vhdl-beginning-of-directive, vhdl-template-context)
+ (vhdl-template-context-hook): New functions.
+ (vhdl-libunit-re, vhdl-defun-re, vhdl-begin-p)
+ (vhdl-corresponding-begin, vhdl-get-library-unit, vhdl-regress-line)
+ (vhdl-align-declarations, vhdl-beginning-of-block, vhdl-end-of-block)
+ (vhdl-font-lock-keywords-2, vhdl-get-end-of-unit)
+ (vhdl-scan-context-clause): Add context.
+
+2015-02-20 Glenn Morris <rgm@gnu.org>
+
+ * calendar/solar.el (solar-sunrise-sunset-string):
+ Shorten message a little.
+ (sunrise-sunset): Use message rather than a window. (Bug#19859)
+
+ * progmodes/f90.el (f90-keywords-re, f90-procedures-re)
+ (f90-font-lock-keywords-2): Some F2008 additions.
+
+2015-02-19 Dima Kogan <dima@secretsauce.net>
+
+ * autorevert.el (auto-revert-buffers-counter)
+ (auto-revert-buffers-counter-lockedout): New variables.
+ (auto-revert-buffers): Increase `auto-revert-buffers-counter'.
+ (auto-revert-notify-handler): Apply `auto-revert-handler' if not
+ suppressed by lockout. (Bug#18958)
+
+2015-02-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-opt.el (eieio-help-class): `eieio-class-parents'
+ returns classes, not class names (bug#19891).
+
+ * emacs-lisp/cl-macs.el (cl-struct-slot-value): Handle a nil type.
+
+ * emacs-lisp/smie.el (smie-prec2->grammar): Fix corner case problem.
+
+2015-02-18 Kelly Dean <kelly@prtime.org>
+
+ * register.el (jump-to-register):
+ * emacs-lisp/lisp.el (check-parens):
+ Push mark before goto-char so user doesn't lose his previous place.
+
+2015-02-18 Kelly Dean <kelly@prtime.org>
+
+ * rect.el (rectangle-mark-mode):
+ Suppress superfluous "Mark set" message from push-mark.
+
+2015-02-18 Kelly Dean <kelly@prtime.org>
+
+ * help-mode.el (help-go-back, help-go-forward, help-follow):
+ * simple.el (yank-pop, pop-to-mark-command, exchange-point-and-mark):
+ * winner.el (winner-redo):
+ * windmove.el (windmove-do-window-select):
+ * register.el (jump-to-register, increment-register, insert-register)
+ (append-to-register, prepend-to-register):
+ * files.el (find-alternate-file, abort-if-file-too-large, write-file)
+ (set-visited-file-name):
+ * emacs-lisp/lisp.el (kill-backward-up-list):
+ Use user-error instead of error. (Bug#14480)
+
+2015-02-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/checkdoc.el (checkdoc-show-diagnostics): Don't make bogus
+ assumptions about window ordering.
+
+2015-02-16 Kelly Dean <kelly@prtime.org>
+
+ * files.el (insert-file-contents-literally): Fix docstring typo.
+
+2015-02-16 Kelly Dean <kelly@prtime.org>
+
+ * emacs-lisp/easy-mmode.el (define-minor-mode): Process macro
+ arguments correctly. (Bug#19685)
+ (define-minor-mode): Clarify docstring.
+ Clarify mode switch messages for minor modes. (Bug#19690)
+
+2015-02-16 Kelly Dean <kelly@prtime.org>
+
+ * emacs-lisp/package-x.el (package-upload-buffer-internal):
+ Create valid tar files. (Bug#19536)
+
+2015-02-16 Kelly Dean <kelly@prtime.org>
+
+ * desktop.el (desktop-read): Conditionally re-enable desktop autosave.
+ (Bug#19059)
+
+2015-02-16 Kelly Dean <kelly@prtime.org>
+
+ * help-mode.el (help-do-xref): Prevent duplicated display of Info
+ buffer, and prevent interference with existing buffer. (Bug#13190)
+
+2015-02-16 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Do not deactivate mark on shell fontification. (Bug#19871)
+
+ * progmodes/python.el (python-shell-font-lock-post-command-hook):
+ Do not deactivate mark on fontification.
+
+2015-02-16 Ivan Shmakov <ivan@siamics.net>
+
+ * net/eww.el: Fix desktop support. (Bug#19226)
+ (eww-mode): Add autoload cookie.
+ (eww-restore-desktop): Use inhibit-read-only.
+
+ * net/eww.el (eww-suggest-uris): Add autoload cookie, so that
+ add-hook works correctly even if the file is not yet loaded.
+
+2015-02-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el (defclass): Use make-instance rather than
+ eieio-constructor.
+ (set-slot-value): Mark as obsolete.
+ (eieio-object-class-name): Improve call to eieio-class-name.
+ (eieio-slot-descriptor-name, eieio-class-slots): New functions.
+ (object-slots): Use it. Declare obsolete.
+ (eieio-constructor): Merge it with `make-instance'.
+ (initialize-instance): Use `dolist'.
+ (eieio-override-prin1, eieio-edebug-prin1-to-string):
+ Use eieio--class-print-name.
+
+ * emacs-lisp/eieio-core.el (eieio--class-print-name): New function.
+ (eieio-class-name): Make it do what the docstring claims.
+ (eieio-defclass-internal): Simplify since `prots' isn't used any more.
+ (eieio--slot-name-index): Simplify accordingly.
+ (eieio-barf-if-slot-unbound): Pass the class object rather than its
+ name to `slot-unbound'.
+
+ * emacs-lisp/eieio-base.el (make-instance): Add a method here rather
+ than on eieio-constructor.
+
+2015-02-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-defstruct): Keep type=nil by default.
+ * emacs-lisp/cl-preloaded.el (cl-struct-define): Add sanity checks
+ about relationship between `type', `named', and `slots'.
+ * emacs-lisp/cl-generic.el (cl--generic-struct-tagcode): Adjust to new
+ value of `cl-struct-type' property.
+
+2015-02-15 Jérémy Compostella <jeremy.compostella@gmail.com>
+
+ * net/tramp-sh.el (tramp-remote-process-environment): Disable paging
+ with PAGER=cat. (Bug#19870)
+
+2015-02-14 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package-read-all-archive-contents):
+ Don't build the compatibility table.
+ (package-refresh-contents, package-initialize): Do build the
+ compatibility table.
+ (package--build-compatibility-table): New function.
+ (describe-package-1): Describe why a package is incompatible.
+
+2015-02-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-preloaded.el (cl-struct-define): Register as children
+ of the parent.
+ (cl--assertion-failed): New function.
+ (cl-assertion-failed): Move in from cl-lib.el.
+
+ * emacs-lisp/cl-macs.el (cl-defstruct): Don't generate code to register
+ as children of its parents.
+ (cl--make-type-test, cl--compiler-macro-typep): Remove functions.
+ (cl-typep): Reimplement using define-inline.
+ (cl-assert): Use cl--assertion-failed.
+ (cl-struct-slot-value): Use define-inline.
+
+ * emacs-lisp/cl-lib.el: Move autoloaded code to cl-preload.
+
+ * textmodes/flyspell.el (flyspell-word): Defvar (bug#19844).
+ (flyspell-generic-check-word-p): Mark as obsolete.
+
+2015-02-13 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package--compatibility-table): New var.
+ (package--add-to-compatibility-table): New function.
+ (package-read-all-archive-contents): Populate compatibility table.
+ (package--incompatible-p): Also look in dependencies.
+ (describe-package-1): Fix "incompat" handling.
+
+2015-02-13 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/rfc2104.el: Moved here from lisp/gnus.
+
+2015-02-13 Magnus Henoch <magnus.henoch@gmail.com>
+
+ * net/sasl-scram-rfc.el: New file.
+
+ * net/sasl.el (sasl-mechanisms): Remove SCRAM-MD5.
+ Add SCRAM-SHA-1 first.
+ (sasl-mechanism-alist): Remove SCRAM-MD5 entry. Add SCRAM-SHA-1
+ entry (bug#17636).
+
+2015-02-13 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-tag-li): Speed up rendering pages with lots of
+ <ul>.
+
+2015-02-12 Oleh Krehel <ohwoeowho@gmail.com>
+
+ * progmodes/gdb-mi.el (gdb-display-io-nopopup): New defcustom.
+ (gdb-inferior-filter): Don't pop up the buried output buffer when
+ `gdb-display-io-nopopup' is non-nil.
+
+2015-02-12 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Allow killing shell buffer if process is dead. (Bug#19823)
+
+ * progmodes/python.el (python-shell-font-lock-kill-buffer):
+ Don't require a running process.
+ (python-shell-font-lock-post-command-hook): Fontify only if the
+ shell process is running.
+
+2015-02-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * hi-lock.el (hi-lock-unface-buffer): Don't call
+ font-lock-remove-keywords if not needed (bug#19796).
+
+2015-02-11 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package-install): Invert the second
+ argument, for better backwards compatibility.
+ (package-install-button-action, package-reinstall)
+ (package-menu-execute): Account for the change.
+
+2015-02-11 Nicolas Petton <nicolas@petton.fr>
+
+ * emacs-lisp/seq.el (seq-reverse): Add a backward-compatible
+ version of seq-reverse that works on sequences in Emacs 24.
+ Bump seq.el version to 1.2.
+
+2015-02-11 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package--incompatible-p): New function.
+ Return non-nil if PKG has no chance of being installable.
+ (package--emacs-version-list): New variable.
+ (describe-package-1, package-desc-status)
+ (package-menu--print-info, package-menu--status-predicate):
+ Account for the "incompat" status.
+
+2015-02-11 Martin Rudalics <rudalics@gmx.at>
+
+ * frame.el (toggle-frame-maximized, toggle-frame-fullscreen):
+ Rename frame parameter `maximized' to `fullscreen-restore'.
+ Restore fullwidth/-height after fullboth state. Update doc-strings.
+
+2015-02-11 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-insert): Make sure the space inserted has the
+ right font (for width).
+ (shr-fill-line): Preserve background colours when indenting/folding.
+ (shr-ensure-paragraph): Don't insert a new paragraph as the first
+ item in a <li>.
+
+2015-02-10 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-use-fonts): New variable.
+ (shr-fill-text): Rename from "fold".
+ (shr-pixel-column, shr-pixel-region, shr-string-pixel-width):
+ New functions.
+ (shr-insert): Just insert, don't fill the text. Filling is now
+ done afterwards per display unit.
+ (shr-fill-lines, shr-fill-line): New functions to fill text on a
+ per-unit base.
+ (shr-find-fill-point): Take a "beginning" parameter.
+ (shr-indent): Indent using the :width display parameter when using
+ fonts.
+ (shr-parse-style): Ignore "inherit" values, since we already do that.
+ (shr-tag-img): Remove the insertion states.
+ (shr-tag-blockquote): New-style filling.
+ (shr-tag-dd): Ditto.
+ (shr-tag-li): Ditto.
+ (shr-mark-fill): New function to mark lines that need filling.
+ (shr-tag-h1): Use a larger font.
+ (shr-tag-table-1): Get the natural and suggested widths in one
+ rendering.
+ (shr-tag-table): Create the "fixed" version of the table only once
+ so that we can cache data in the table.
+ (shr-insert-table): Get colspan calculations right by having
+ zero-width columns after colspan ones.
+ (shr-expand-alignments): New function to make :align-to specs work
+ right when rendered in one buffer and displayed in another one.
+ (shr-insert-table-ruler): Use :align-to to get the widths right.
+ (shr-make-table): Cache more.
+ (shr-make-table-1): Use the new <td> data layout.
+ (shr-pixel-buffer-width): New function.
+ (shr-render-td): Add a caching layer.
+ (shr-dom-max-natural-width): New function.
+ (shr-tag-h1): Don't use variable-pitch fonts on fontless rendering.
+ (shr-tag-tt): New function.
+ (shr-tag-hr): Compute the right length when using fonts.
+ (shr-table-widths): Off-by-one error in width computation.
+ (shr-expand-newlines): Remove dead code.
+ (shr-insert-table): Extend background colors to the end of the column.
+ (shr-insert-table): Only copy the background, not underline and
+ the like.
+ (shr-face-background): New function.
+
+2015-02-10 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Improved shell font lock respecting markers. (Bug#19650)
+
+ * progmodes/python.el
+ (python-shell-font-lock-get-or-create-buffer): Use special buffer name.
+ (python-shell-font-lock-with-font-lock-buffer): Enable font lock.
+ (python-shell-font-lock-post-command-hook): Fontify by copying text
+ properties from fontified buffer to shell, keeping markers unchanged.
+ (python-shell-font-lock-turn-off): Fix typo.
+ (python-util-text-properties-replace-name): Delete function.
+
+2015-02-09 Nicolas Petton <nicolas@petton.fr>
+
+ * emacs-lisp/seq.el (seq-group-by): Improves seq-group-by to
+ return sequence elements in correct order.
+
+2015-02-09 Simen Heggestøyl <simenheg@gmail.com> (tiny change)
+
+ * textmodes/css-mode.el (css-smie-rules): Fix paren indent (bug#19815).
+
+2015-02-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-generic.el (cl--generic-lambda): Use macroexp-parse-body.
+
+ * emacs-lisp/eieio-core.el (eieio-oset-default): Catch the unexpected
+ case where the default value would be re-interpreted as a form!
+
+2015-02-09 Christopher Genovese <genovese@cmu.edu> (tiny change)
+
+ * help-fns.el (help-fns--signature): Keep doc for keymap.
+
+2015-02-09 Kelly Dean <kelly@prtime.org>
+
+ * desktop.el: Save mark-ring less verbosely.
+ (desktop-var-serdes-funs): New var.
+ (desktop-buffer-info, desktop-create-buffer): Use it.
+ (desktop-file-version): Update to 208.
+
+2015-02-09 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/pcase.el (pcase-lambda): New Macro. (Bug#19814)
+
+ * emacs-lisp/lisp-mode.el (el-kws-re): Include `pcase-lambda'.
+
+ * emacs-lisp/macroexp.el (macroexp-parse-body): New function.
+
+2015-02-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port to platforms lacking test -a and -o
+ * Makefile.in (compile-clean):
+ * net/tramp-sh.el (tramp-find-executable):
+ Prefer '&&' and '||' to 'test -a' and 'test -o'.
+
+2015-02-08 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * newcomment.el (comment-line): Fix missing paren.
+
+2015-02-08 Ulrich Müller <ulm@gentoo.org>
+
+ * play/gamegrid.el: Update comment to reflect that the
+ 'update-game-score' helper program is now setgid by default.
+
+2015-02-08 David Kastrup <dak@gnu.org>
+
+ * subr.el (apply-partially): Use lexical binding here.
+
+2015-02-08 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * newcomment.el (comment-line): New command.
+
+ * bindings.el (ctl-x-map): Bind to `C-x C-;'.
+
+2015-02-08 Oleh Krehel <ohwoeowho@gmail.com>
+
+ * outline.el (outline-show-entry): Fix one invisible char for the
+ file's last outline. (Bug#19493)
+
+2015-02-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (indirect-function): Change advertised calling convention.
+
+2015-02-08 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Fix completion-at-point. (Bug#19667)
+
+ * progmodes/python.el
+ (python-shell-completion-native-get-completions): Force process buffer.
+ (python-shell-completion-at-point): Handle case where call is not
+ in a shell buffer.
+
+2015-02-08 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Fix shell font-lock multiline input. (Bug#19744)
+
+ * progmodes/python.el
+ (python-shell-font-lock-post-command-hook): Handle multiline input.
+
+2015-02-08 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Make shell font-lock respect markers. (Bug#19650)
+
+ * progmodes/python.el (python-shell-font-lock-cleanup-buffer):
+ Use `erase-buffer`.
+ (python-shell-font-lock-comint-output-filter-function):
+ Handle newlines.
+ (python-shell-font-lock-post-command-hook): Respect markers on
+ text fontification.
+
+2015-02-07 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Keep eldoc visible while typing args. (Bug#19637)
+ * progmodes/python.el (python-eldoc--get-symbol-at-point):
+ New function based on Carlos Pita <carlosjosepita@gmail.com> patch.
+ (python-eldoc--get-doc-at-point, python-eldoc-at-point): Use it.
+
+2015-02-07 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ Fix hideshow integration. (Bug#19761)
+ * progmodes/python.el
+ (python-hideshow-forward-sexp-function): New function based on
+ Carlos Pita <carlosjosepita@gmail.com> patch.
+ (python-mode): Make `hs-special-modes-alist` use it and initialize
+ the end regexp with the empty string to avoid skipping parens.
+
+2015-02-07 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-check-custom-command): Do not use
+ defvar-local for compat with Emacs<24.3.
+
+2015-02-07 Martin Rudalics <rudalics@gmx.at>
+
+ * frame.el (frame-notice-user-settings):
+ Update `frame-size-history'.
+ (make-frame): Update `frame-size-history'.
+ Call `frame-after-make-frame'.
+ * faces.el (face-set-after-frame-default): Remove call to
+ frame-can-run-window-configuration-change-hook.
+
+2015-02-06 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-cvs.el (vc-cvs-dir-status-files): Don't pass DIR to
+ `vc-cvs-command' (bug#19732).
+
+2015-02-06 Nicolas Petton <nicolas@petton.fr>
+
+ * emacs-lisp/seq.el (seq-mapcat, seq-partition, seq-group-by):
+ New functions.
+ * emacs-lisp/seq.el (seq-drop-while, seq-take-while, seq-count)
+ (seq--drop-list, seq--take-list, seq--take-while-list):
+ Better docstring.
+
+2015-02-06 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * doc-view.el (doc-view-kill-proc-and-buffer): Obsolete. Use
+ `image-kill-buffer' instead.
+
+2015-02-06 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/ldap.el (ldap-search-internal): Fix docstring.
+
+2015-02-06 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * subr.el (define-error): The error conditions may be constant
+ lists, so use `append' to concatenate them.
+
+2015-02-06 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * net/network-stream.el (network-stream-open-tls): Respect the
+ :end-of-capability setting.
+
+2015-02-05 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package--sort-by-dependence):
+ New function. Return PACKAGE-LIST sorted by dependencies.
+ (package-menu-execute): Use it to delete packages in order.
+ (package--sort-deps-in-alist): New function.
+ (package-menu-mark-install): Can mark dependencies.
+ (package--newest-p): New function.
+ (package-delete): Don't deselect when deleting an older version of
+ an upgraded package.
+
+ * emacs-lisp/package.el: Add missing (require 'subr-x)
+
+2015-02-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * textmodes/css-mode.el (scss-smie--not-interpolation-p): Vars can be
+ hyphenated (bug#19263).
+
+ * textmodes/css-mode.el (css-fill-paragraph): Fix filling in presence
+ of variable interpolation (bug#19751).
+
+2015-02-05 Era Eriksson <era+emacs@iki.fi>
+
+ * json.el (json-end-of-file): New error (bug#19768).
+ (json-pop, json-read): Use it.
+
+2015-02-05 Kelly Dean <kelly@prtime.org>
+
+ * help-mode.el (help-xref-interned): Pass BUFFER and FRAME to
+ `describe-variable'.
+
+ * help-fns.el (describe-function-or-variable): New function.
+
+ * help.el (help-map): Bind `describe-function-or-variable' to o.
+ (help-for-help-internal): Document o key.
+
+2015-02-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-compat.el (eieio--defmethod): Use new
+ special (:documentation ...) feature.
+ * emacs-lisp/eieio-core.el (eieio-make-class-predicate)
+ (eieio-make-child-predicate): Same.
+ (eieio-copy-parents-into-subclass): Remove unused arg.
+ (eieio-defclass-internal): Adjust call accordingly and remove redundant
+ `pname' var.
+ (eieio--slot-name-index): Remove unused arg `obj' and adjust all
+ callers accordingly.
+
+ * emacs-lisp/cconv.el (cconv--convert-function):
+ Add `docstring' argument.
+ (cconv-convert): Use it to handle the new (:documentation ...) form.
+ (cconv-analyze-form): Handle the new (:documentation ...) form.
+
+ * emacs-lisp/bytecomp.el:
+ (byte-compile-initial-macro-environment): Use macroexp-progn.
+ (byte-compile-cl-warn): Don't silence use of cl-macroexpand-all.
+ (byte-compile-file-form-defvar-function): Rename from
+ byte-compile-file-form-define-abbrev-table.
+ (defvaralias, byte-compile-file-form-custom-declare-variable): Use it.
+ (byte-compile): Use byte-compile-top-level rather than
+ byte-compile-lambda so we can compile non-values.
+ (byte-compile-form): Add warnings for failed uses of lexical vars via
+ quoted symbols.
+ (byte-compile-unfold-bcf): Improve message for failed inlining.
+ (byte-compile-make-closure): Handle new format of internal-make-closure
+ for dynamically-generated docstrings.
+
+ * delsel.el: Deprecate the `kill' option. Use lexical-binding.
+ (open-line): Delete like all other commands, instead of killing.
+ (delete-active-region): Don't define any return any value.
+
+ * progmodes/python.el: Try to preserve compatibility with Emacs-24.
+ (python-mode): Don't assume eldoc-documentation-function has a non-nil
+ default.
+
+2015-02-04 Sam Steingold <sds@gnu.org>
+
+ * progmodes/python.el (python-indent-calculate-indentation):
+ Avoid the error when computing top-level indentation.
+
+2015-02-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-generic.el (cl--generic-member-method): Fix paren typo.
+
+ * textmodes/flyspell.el: Use lexical-binding and cl-lib.
+ (mail-mode-flyspell-verify): Fix last change.
+ (flyspell-external-point-words, flyspell-large-region):
+ Avoid add-to-list on local vars.
+
+2015-02-04 Tassilo Horn <tsdh@gnu.org>
+
+ * emacs-lisp/package.el (package-installed-p): Fix typo causing
+ void-variable error.
+
+2015-02-04 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * image-mode.el (image-kill-buffer): New command.
+ (image-mode-map): Bind it to k.
+
+ * emacs-lisp/package.el (package-delete): Remove package from
+ `package-selected-packages' even if it can't be deleted.
+ (package-installed-p): Accept package-desc objects.
+ (package-install): Can be used to mark dependencies as
+ selected. When given a package-desc object which is already
+ installed, the package is not downloaded again, but it is marked
+ as selected (if it wasn't already).
+ (package-reinstall): Accept package-desc objects.
+
+2015-02-03 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package-delete): Document NOSAVE.
+ (package--get-deps): delete-dups when ONLY is nil.
+ (package-autoremove): Warn the user if `package-selected-packages'
+ is empty.
+
+ (package--user-selected-p): New function.
+ (package-delete, package-install, package-install-from-buffer):
+ Use it
+ (package-selected-packages): Mention it.
+
+ (package-initialize): Don't populate `package-selected-packages'.
+ (package-install-user-selected-packages, package-autoremove):
+ Special handling for empty `package-selected-packages'.
+ (package-install): Fix when PKG is a package-desc.
+
+ (package-desc-status): Add "dependency" status to the Package
+ Menu.
+ (package-menu--status-predicate, package-menu--print-info)
+ (package-menu-mark-delete, package-menu--find-upgrades)
+ (package-menu--status-predicate, describe-package-1): Use it
+
+ (package--removable-packages): New function.
+ (package-autoremove): Use it.
+ (package-menu-execute): Offer to remove unneeded packages.
+
+ (package--read-pkg-desc, package-tar-file-info): Fix reference to
+ tar-desc.
+
+2015-02-03 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * emacs-lisp/package.el (package-reinstall): Don't change package's selected status.
+ (package-delete): New NOSAVE argument.
+
+2015-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-histfile-override): Fix docstring.
+ (tramp-open-shell, tramp-maybe-open-connection): Set also
+ HISTFILESIZE and HISTSIZE when needed. (Bug#19731)
+
+2015-02-02 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package--find-non-dependencies):
+ New function.
+ (package-initialize): Use it to populate `package-selected-packages'.
+ (package-menu-execute): Clean unnecessary `and'.
+ (package--get-deps): Fix returning duplicates.
+
+2015-02-02 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-histfile-override): Add another choice t.
+ Use it as default.
+ (tramp-open-shell, tramp-maybe-open-connection): Support it.
+ (Bug#19731)
+
+2015-02-02 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * emacs-lisp/package.el (package-delete): Remove package from
+ package-selected-packages.
+ (package-autoremove): Remove unneeded variable.
+
+2015-02-01 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package-selected-packages): Fix :type
+ (package-install): Rename ARG to MARK-SELECTED.
+ (package--get-deps): Fix for indirect dependencies.
+ (package-used-elsewhere-p): Rename to
+ (package--used-elsewhere-p): New function.
+ (package-reinstall, package-user-selected-packages-install)
+ (package-autoremove): Use sharp-quote.
+ (package-user-selected-packages-install): Reindent and rename to
+ (package-install-user-selected-packages): New function.
+
+2015-02-01 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * emacs-lisp/package.el: Don't allow deleting dependencies.
+
+ (package-used-elsewhere-p): New function.
+ (package-delete): Use it, return now an error when trying to
+ delete a package used as dependency by another package.
+
+ Add a reinstall package command.
+ (package-reinstall): New function.
+
+ Add a package-autoremove command.
+ (package-selected-packages): New user var.
+ (package-install): Add an optional arg to notify interactive use.
+ Fix docstring. Save installed package to
+ packages-installed-directly.
+ (package-install-from-buffer): Same.
+ (package-user-selected-packages-install): Allow installing all
+ packages in packages-installed-directly at once.
+ (package--get-deps): New function.
+ (package-autoremove): New function.
+ (package-install-button-action): Call package-install with
+ interactive arg.
+ (package-menu-execute): Same but only for only for not installed
+ packages.
2015-01-31 Stefan Monnier <monnier@iro.umontreal.ca>
2015-01-30 Oleh Krehel <ohwoeowho@gmail.com>
- * lisp/custom.el (defface): Set `indent' to 1.
+ * custom.el (defface): Set `indent' to 1.
2015-01-30 Oleh Krehel <ohwoeowho@gmail.com>
2015-01-30 Michal Nazarewicz <mina86@mina86.com>
- * lisp/files.el (save-buffers-kill-emacs): If `confirm-kill-emacs'
+ * files.el (save-buffers-kill-emacs): If `confirm-kill-emacs'
is set, but user has just been asked whether they really want to
kill Emacs (for example with a ‘Modified buffers exist; exit
anyway?’ prompt), do not ask them for another confirmation.
2015-01-29 Jay Belanger <jay.p.belanger@gmail.com>
- * lisp/calc/calc-units.el (calc-convert-exact-units): New function.
+ * calc/calc-units.el (calc-convert-exact-units): New function.
(calc-convert-units): Check for missing units.
(math-consistent-units-p): Strengthen the test for consistent units.
- * lisp/calc/calc-ext.el (calc-init-extensions): Autoload
+ * calc/calc-ext.el (calc-init-extensions): Autoload
`calc-convert-exact-units' and assign it a keybinding.
- * lisp/calc/calc-help (calc-u-prefix-help): Add help for the
+ * calc/calc-help (calc-u-prefix-help): Add help for the
"un" keybinding.
2015-01-28 Stefan Monnier <monnier@iro.umontreal.ca>
2015-01-28 Paul Eggert <eggert@cs.ucla.edu>
- Fix dired quoting bug with "Hit`N`Hide". Fixes Bug#19498.
- * files.el (shell-quote-wildcard-pattern): Also quote "`".
+ Fix dired quoting bug with "Hit`N`Hide".
+ * files.el (shell-quote-wildcard-pattern): Also quote "`". (Bug#19498)
2015-01-28 Stefan Monnier <monnier@iro.umontreal.ca>
2015-01-17 Ivan Shmakov <ivan@siamics.net>
- * url/url-cookie.el (url-cookie-write-file): Let-bind print-length
- and print-level to nil to avoid writing a garbled list. (Bug#16805)
-
* files.el (find-file-other-window, find-file-other-frame):
Use mapc instead of mapcar. (Bug#18175)
* vc/vc-svn.el (vc-svn-dir-status-files): Pass t as
vc-svn-after-dir-status's second argument. (Bug#19429)
-2015-01-16 Samer Masterson <samer@samertm.com> (tiny change)
+2015-01-16 Samer Masterson <samer@samertm.com>
* pcomplete.el (pcomplete-parse-arguments): Parse arguments
regardless of pcomplete-cycle-completions's value. (Bug#18950)
* emacs-lisp/package.el (package--list-loaded-files): Don't call
file-truename on load-history elements (bug#19390).
-2014-12-16 Nicolas Petton <petton.nicolas@gmail.com>
+2014-12-16 Nicolas Petton <petton.nicolas@gmail.com>
* emacs-lisp/seq.el: New file.
Pass correct status to `newsticker--sentinel-work'.
(newsticker--sentinel-work): Use "newsticker--download-error" as
guid in order to prevent multiple "Could not download..."
- messages. Fixes bug#19166.
+ messages. (Bug#19166)
2014-12-01 Ivan Shmakov <ivan@siamics.net>
2014-11-22 Alan Mackenzie <acm@muc.de>
Fix error with `mark-defun' and "protected:" in C++ Mode.
- Fixes: debbugs:19134.
-
* progmodes/cc-cmds.el (c-where-wrt-brace-construct): Handle a
- return code of (label) from c-beginning-of-decl-1.
+ return code of (label) from c-beginning-of-decl-1. (Bug#19134)
2014-11-22 Ulf Jasper <ulf.jasper@web.de>
* net/newst-backend.el (newsticker--sentinel-work):
- Tell `libxml-parse-xml-region' to discard comments. Fixes bug#18787.
+ Tell `libxml-parse-xml-region' to discard comments. (Bug#18787)
2014-11-22 Michael Albinus <michael.albinus@gmx.de>
(tildify-foreach-region-function): New variable specifying
a function determining portions of buffer that should be
tildified. It allows major modes to create a filtering function
- more elaborate than a set of regular expressions. Initialised to
+ more elaborate than a set of regular expressions. Initialized to
`tildify--deprecated-ignore-evironments' by default to handle now
deprecated `tildify-ignored-environments-alist' variable.
(tildify--foreach-region): A new function that takes
(python-shell-calculate-process-environment): Use it.
(python-shell-calculate-exec-path): Add comment.
-2014-11-16 Thierry Banel <tbanelwebmin@free.fr> (tiny change)
+2014-11-16 Thierry Banel <tbanelwebmin@free.fr> (tiny change)
* calc/calc-arith.el (math-max-list, math-min-list): Fix bug
for date handling.
* mail/emacsbug.el (report-emacs-bug): Make a better guess at
envelope-from when reporting through sendmail (bug#19054).
-2014-11-16 Oscar Fuentes <ofv@wanadoo.es>
+2014-11-16 Oscar Fuentes <ofv@wanadoo.es>
Add faces for the VC modeline state indicator.
* vc/vc-hooks.el:
2014-11-08 Alan Mackenzie <acm@muc.de>
- Fix wrong bound to c-font-lock-declarators. Fixes bug #18948.
+ Fix wrong bound to c-font-lock-declarators.
* progmodes/cc-fonts.el (c-font-lock-declarations):
Pass "(point-max)" as bound to c-font-lock-declarators, not "limit", as
the buffer is sometimes narrowed to less than "limit" (e.g., in
- the presence of macros).
+ the presence of macros). (Bug#18948)
2014-11-08 Michael Albinus <michael.albinus@gmx.de>
correct buffer.
(eww-view-source): Use it.
-2014-11-02 Ivan Shmakov <ivan@siamics.net>
+2014-11-02 Ivan Shmakov <ivan@siamics.net>
* net/eww.el (eww): Recognize colon-delimited IPv6 addresses.
(Bug#18603).
-2014-11-02 Brian McKenna <brian@brianmckenna.org> (tiny change)
+2014-11-02 Brian McKenna <brian@brianmckenna.org> (tiny change)
* net/eww.el (eww-submit): Encode empty form values as "". (Bug#17785).
-2014-11-02 Ivan Shmakov <ivan@siamics.net>
+2014-11-02 Ivan Shmakov <ivan@siamics.net>
* net/eww.el (eww): Allow "file:/file/name" URLs. (Bug#18825).
-2014-11-02 Ivan Shmakov <ivan@siamics.net>
+2014-11-02 Ivan Shmakov <ivan@siamics.net>
* net/eww.el (eww-mode-map): Remove mentions of `eww-quit'.
(Bug#18834).
2014-10-18 Alan Mackenzie <acm@muc.de>
Check that a "macro" found near point-min isn't a ## operator.
- Fixes bug #18749.
* progmodes/cc-engine.el (c-macro-is-genuine-p): New function.
- (c-beginning-of-macro): Use the above new function.
+ (c-beginning-of-macro): Use the above new function. (Bug#18749)
2014-10-18 Teodor Zlatanov <tzz@lifelogs.com>
file-format 2 --- ie. no local printers --- and 3 --- i.e. may have
local printers.
(ses-localvars): Add local variables needed for local printer handling.
- (ses-set-localvars): Handle hashmap initialisation.
+ (ses-set-localvars): Handle hashmap initialization.
(ses-paramlines-plist): Add param-line for number of local printers.
(ses-paramfmt-plist): New defconst, needed for code factorization
between functions `ses-set-parameter' and
* progmodes/cc-mode.el (c-initialize-cc-mode): Add CC Mode hooks
to electric-indent-{,local-}-mode.
(c-basic-common-init): Set electric-indent-inhibit.
- Initialise c-electric-flag from electric-indent-mode.
+ Initialize c-electric-flag from electric-indent-mode.
(c-electric-indent-mode-hook, c-electric-indent-local-mode-hook):
New hook functions which propagate electric-indent-mode to CC mode.
Change default to "# encoding: %s" to differentiate it from the
default Ruby encoding comment template.
-2013-11-20 era eriksson <era+emacsbugs@iki.fi>
+2013-11-20 Era Eriksson <era+emacsbugs@iki.fi>
* ses.el (ses-mode): Doc fix. (Bug#14748)
2013-04-30 Alan Mackenzie <acm@muc.de>
- Handle arbitrarily long C++ member initialisation lists.
+ Handle arbitrarily long C++ member initialization lists.
* progmodes/cc-engine.el (c-back-over-member-initializers):
new function.
(c-guess-basic-syntax): New CASE 5R (extracted from 5B) to handle
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.
+ Initialize c-state-semi-nonlit-pos-cache\(-limit\)? properly.
(c-record-parse-state-state):
Record c-state-semi-nonlit-pos-cache\(-limit\)?.
(c-nonlabel-token-key): Allow string literals for AWK.
Refactor for the other modes.
- Large brace-block initialisation makes CC Mode slow: Fix.
+ Large brace-block initialization makes CC Mode slow: Fix.
Tidy up and accelerate c-in-literal, etc. by using the c-parse-state
routines. Limit backward searching in c-font-lock-enclosing.decl.
# We never change directory before running Emacs, so a relative file
# name is fine, and makes life easier. If we need to change
# directory, we can use emacs --chdir.
-EMACS = ../src/emacs
+EMACS = ../src/emacs${EXEEXT}
# Command line flags for Emacs.
@cd $(lisp) && $(setwins); \
elcs=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.elc |g'`; \
for el in `echo $$elcs | sed -e 's/\.elc/\.el/g'`; do \
- if test -f "$$el" -o \! -f "$${el}c"; then :; else \
+ if test -f "$$el" || test ! -f "$${el}c"; then :; else \
echo rm "$${el}c"; \
rm "$${el}c"; \
fi \
;; We used to manually add the docstring, but we also want to record this
;; location as the definition of the variable (in load-history), so we may
;; as well just use `defvar'.
- (eval `(defvar ,tablename nil ,@(if (stringp docstring) (list docstring))))
+ (eval `(defvar ,tablename nil ,@(if (stringp docstring) (list docstring)
+ (when props (push docstring props) nil))))
(let ((table (if (boundp tablename) (symbol-value tablename))))
(unless table
(setq table (make-abbrev-table))
;; if the table was pre-existing as is the case if it was created by
;; loading the user's abbrev file.
(while (consp props)
+ (unless (cdr props) (error "Missing value for property %S" (car props)))
(abbrev-table-put table (pop props) (pop props)))
(dolist (elt definitions)
(apply 'define-abbrev table elt))))
(delq (current-buffer) auto-revert-buffer-list)))
(auto-revert-set-timer)
(when auto-revert-mode
- (let (auto-revert-use-notify)
- (auto-revert-buffers)
- (setq auto-revert-tail-mode nil))))
+ (auto-revert-buffers)
+ (setq auto-revert-tail-mode nil)))
;;;###autoload
(y-or-n-p "File changed on disk, content may be missing. \
Perform a full revert? ")
;; Use this (not just revert-buffer) for point-preservation.
- (let (auto-revert-use-notify)
- (auto-revert-handler)))
+ (auto-revert-buffers))
;; else we might reappend our own end when we save
(add-hook 'before-save-hook (lambda () (auto-revert-tail-mode 0)) nil t)
(or (local-variable-p 'auto-revert-tail-pos) ; don't lose prior position
:global t :group 'auto-revert :lighter global-auto-revert-mode-text
(auto-revert-set-timer)
(if global-auto-revert-mode
- (let (auto-revert-use-notify)
- (auto-revert-buffers))
+ (auto-revert-buffers)
(dolist (buf (buffer-list))
(with-current-buffer buf
(when auto-revert-use-notify
"Enable file notification for current buffer's associated file."
;; We can assume that `buffer-file-name' and
;; `auto-revert-use-notify' are non-nil.
- (when (or (string-match auto-revert-notify-exclude-dir-regexp
- (expand-file-name default-directory))
- (file-symlink-p buffer-file-name))
- ;; Fallback to file checks.
- (set (make-local-variable 'auto-revert-use-notify) nil))
-
- (when (not auto-revert-notify-watch-descriptor)
- (setq auto-revert-notify-watch-descriptor
- (ignore-errors
- (file-notify-add-watch
- (expand-file-name buffer-file-name default-directory)
- '(change attribute-change) 'auto-revert-notify-handler)))
- (if auto-revert-notify-watch-descriptor
- (progn
- (puthash
- auto-revert-notify-watch-descriptor
- (cons (current-buffer)
- (gethash auto-revert-notify-watch-descriptor
- auto-revert-notify-watch-descriptor-hash-list))
- auto-revert-notify-watch-descriptor-hash-list)
- (add-hook (make-local-variable 'kill-buffer-hook)
- 'auto-revert-notify-rm-watch))
+ (if (or (string-match auto-revert-notify-exclude-dir-regexp
+ (expand-file-name default-directory))
+ (file-symlink-p (or buffer-file-name default-directory)))
+
;; Fallback to file checks.
- (set (make-local-variable 'auto-revert-use-notify) nil))))
+ (set (make-local-variable 'auto-revert-use-notify) nil)
+
+ (when (not auto-revert-notify-watch-descriptor)
+ (setq auto-revert-notify-watch-descriptor
+ (ignore-errors
+ (if buffer-file-name
+ (file-notify-add-watch
+ (expand-file-name buffer-file-name default-directory)
+ '(change attribute-change)
+ 'auto-revert-notify-handler)
+ (file-notify-add-watch
+ (expand-file-name default-directory)
+ '(change)
+ 'auto-revert-notify-handler))))
+ (if auto-revert-notify-watch-descriptor
+ (progn
+ (puthash
+ auto-revert-notify-watch-descriptor
+ (cons (current-buffer)
+ (gethash auto-revert-notify-watch-descriptor
+ auto-revert-notify-watch-descriptor-hash-list))
+ auto-revert-notify-watch-descriptor-hash-list)
+ (add-hook (make-local-variable 'kill-buffer-hook)
+ 'auto-revert-notify-rm-watch))
+ ;; Fallback to file checks.
+ (set (make-local-variable 'auto-revert-use-notify) nil)))))
+
+;; If we have file notifications, we want to update the auto-revert buffers
+;; immediately when a notification occurs. Since file updates can happen very
+;; often, we want to skip some revert operations so that we don't spend all our
+;; time reverting the buffer.
+;;
+;; We do this by reverting immediately in response to the first in a flurry of
+;; notifications. We suppress subsequent notifications until the next time
+;; `auto-revert-buffers' is called (this happens on a timer with a period set by
+;; `auto-revert-interval').
+(defvar auto-revert-buffers-counter 1
+ "Incremented each time `auto-revert-buffers' is called")
+(defvar-local auto-revert-buffers-counter-lockedout 0
+ "Buffer-local value to indicate whether we should immediately
+update the buffer on a notification event or not. If
+
+ (= auto-revert-buffers-counter-lockedout
+ auto-revert-buffers-counter)
+
+then the updates are locked out, and we wait until the next call
+of `auto-revert-buffers' to revert the buffer. If no lockout is
+present, then we revert immediately and set the lockout, so that
+no more reverts are possible until the next call of
+`auto-revert-buffers'")
(defun auto-revert-notify-handler (event)
"Handle an EVENT returned from file notification."
auto-revert-notify-watch-descriptor-hash-list)))
;; Check, that event is meant for us.
(cl-assert descriptor)
- ;; We do not handle `deleted', because nothing has to be refreshed.
- (unless (eq action 'deleted)
- (cl-assert (memq action '(attribute-changed changed created renamed))
- t)
- ;; Since we watch a directory, a file name must be returned.
- (cl-assert (stringp file))
- (when (eq action 'renamed) (cl-assert (stringp file1)))
- ;; Loop over all buffers, in order to find the intended one.
- (cl-dolist (buffer buffers)
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (when (and (stringp buffer-file-name)
- (or
- (and (memq action '(attribute-changed changed
- created))
- (string-equal
- (file-name-nondirectory file)
- (file-name-nondirectory buffer-file-name)))
- (and (eq action 'renamed)
- (string-equal
- (file-name-nondirectory file1)
- (file-name-nondirectory buffer-file-name)))))
- ;; Mark buffer modified.
- (setq auto-revert-notify-modified-p t)
- ;; No need to check other buffers.
- (cl-return)))))))))
+ ;; Since we watch a directory, a file name must be returned.
+ (cl-assert (stringp file))
+ (when (eq action 'renamed) (cl-assert (stringp file1)))
+ ;; Loop over all buffers, in order to find the intended one.
+ (cl-dolist (buffer buffers)
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (when (or
+ ;; A buffer associated with a file.
+ (and (stringp buffer-file-name)
+ (or
+ (and (memq action '(attribute-changed changed created))
+ (string-equal
+ (file-name-nondirectory file)
+ (file-name-nondirectory buffer-file-name)))
+ (and (eq action 'renamed)
+ (string-equal
+ (file-name-nondirectory file1)
+ (file-name-nondirectory buffer-file-name)))))
+ ;; A buffer w/o a file, like dired.
+ (and (null buffer-file-name)
+ (memq action '(created renamed deleted))))
+ ;; Mark buffer modified.
+ (setq auto-revert-notify-modified-p t)
+
+ ;; Revert the buffer now if we're not locked out.
+ (when (/= auto-revert-buffers-counter-lockedout
+ auto-revert-buffers-counter)
+ (auto-revert-handler)
+ (setq auto-revert-buffers-counter-lockedout
+ auto-revert-buffers-counter))
+
+ ;; No need to check other buffers.
+ (cl-return))))))))
(defun auto-revert-active-p ()
"Check if auto-revert is active (in current buffer or globally)."
This function is also responsible for removing buffers no longer in
Auto-Revert mode from `auto-revert-buffer-list', and for canceling
the timer when no buffers need to be checked."
+
+ (setq auto-revert-buffers-counter
+ (1+ auto-revert-buffers-counter))
+
(save-match-data
(let ((bufs (if global-auto-revert-mode
(buffer-list)
(delq buf auto-revert-buffer-list)))
(when (auto-revert-active-p)
;; Enable file notification.
- (when (and auto-revert-use-notify buffer-file-name
+ (when (and auto-revert-use-notify
(not auto-revert-notify-watch-descriptor))
(auto-revert-notify-add-watch))
(auto-revert-handler)))
(defcustom battery-status-function
(cond ((and (eq system-type 'gnu/linux)
(file-readable-p "/proc/apm"))
- 'battery-linux-proc-apm)
+ #'battery-linux-proc-apm)
((and (eq system-type 'gnu/linux)
(file-directory-p "/proc/acpi/battery"))
- 'battery-linux-proc-acpi)
+ #'battery-linux-proc-acpi)
((and (eq system-type 'gnu/linux)
(file-directory-p "/sys/class/power_supply/")
(directory-files "/sys/class/power_supply/" nil
battery--linux-sysfs-regexp))
- 'battery-linux-sysfs)
+ #'battery-linux-sysfs)
((and (eq system-type 'berkeley-unix)
(file-executable-p "/usr/sbin/apm"))
- 'battery-bsd-apm)
+ #'battery-bsd-apm)
((and (eq system-type 'darwin)
(condition-case nil
(with-temp-buffer
(and (eq (call-process "pmset" nil t nil "-g" "ps") 0)
(> (buffer-size) 0)))
(error nil)))
- 'battery-pmset)
+ #'battery-pmset)
((fboundp 'w32-battery-status)
- 'w32-battery-status))
+ #'w32-battery-status))
"Function for getting battery status information.
The function has to return an alist of conversion definitions.
Its cons cells are of the form
:group 'battery)
(defcustom battery-echo-area-format
- (cond ((eq battery-status-function 'battery-linux-proc-acpi)
- "Power %L, battery %B at %r (%p%% load, remaining time %t)")
- ((eq battery-status-function 'battery-linux-sysfs)
- "Power %L, battery %B (%p%% load, remaining time %t)")
- ((eq battery-status-function 'battery-pmset)
- "%L power, battery %B (%p%% load, remaining time %t)")
- (battery-status-function
- "Power %L, battery %B (%p%% load, remaining time %t)"))
+ "Power %L, battery %B (%p%% load, remaining time %t)"
"Control string formatting the string to display in the echo area.
Ordinary characters in the control string are printed as-is, while
conversion specifications introduced by a `%' character in the control
%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 (charging-state rate temperature hours
- (charge-full 0.0)
- (charge-now 0.0)
+ (let (charging-state temperature hours
+ ;; Some batteries report charges and current, other energy and power.
+ ;; In order to reliably be able to combine those data, we convert them
+ ;; all to energy/power (since we can't combine different charges if
+ ;; they're not at the same voltage).
(energy-full 0.0)
- (energy-now 0.0))
+ (energy-now 0.0)
+ (power-now 0.0)
+ (voltage-now 10.8)) ;Arbitrary default, in case the info is missing.
;; SysFS provides information about each battery present in the
;; system in a separate subdirectory. We are going to merge the
;; available information together.
(erase-buffer)
(ignore-errors (insert-file-contents
(expand-file-name "uevent" dir)))
+ (goto-char (point-min))
+ (when (re-search-forward
+ "POWER_SUPPLY_VOLTAGE_NOW=\\([0-9]*\\)$" nil t)
+ (setq voltage-now (/ (string-to-number (match-string 1)) 1000000.0)))
+ (goto-char (point-min))
(when (re-search-forward "POWER_SUPPLY_PRESENT=1$" nil t)
(goto-char (point-min))
(and (re-search-forward "POWER_SUPPLY_STATUS=\\(.*\\)$" nil t)
(when (re-search-forward
"POWER_SUPPLY_\\(CURRENT\\|POWER\\)_NOW=\\([0-9]*\\)$"
nil t)
- (setq rate (float (string-to-number (match-string 2)))))
+ (cl-incf power-now
+ (* (float (string-to-number (match-string 2)))
+ (if (eq (char-after (match-beginning 1)) ?C)
+ voltage-now 1.0))))
(goto-char (point-min))
(when (re-search-forward "POWER_SUPPLY_TEMP=\\([0-9]*\\)$" nil t)
(setq temperature (match-string 1)))
(re-search-forward
"POWER_SUPPLY_CHARGE_NOW=\\([0-9]*\\)$" nil t)
(setq now-string (match-string 1)))
- (setq charge-full (+ charge-full
- (string-to-number full-string))
- charge-now (+ charge-now
- (string-to-number now-string))))
+ (cl-incf energy-full (* (string-to-number full-string)
+ voltage-now))
+ (cl-incf energy-now (* (string-to-number now-string)
+ voltage-now)))
((and (progn (goto-char (point-min)) t)
(re-search-forward
"POWER_SUPPLY_ENERGY_FULL=\\([0-9]*\\)$" nil t)
(re-search-forward
"POWER_SUPPLY_ENERGY_NOW=\\([0-9]*\\)$" nil t)
(setq now-string (match-string 1)))
- (setq energy-full (+ energy-full
- (string-to-number full-string))
- energy-now (+ energy-now
- (string-to-number now-string))))))
+ (cl-incf energy-full (string-to-number full-string))
+ (cl-incf energy-now (string-to-number now-string)))))
(goto-char (point-min))
- (when (and energy-now rate (not (zerop rate))
- (re-search-forward
- "POWER_SUPPLY_VOLTAGE_NOW=\\([0-9]*\\)$" nil t))
+ (unless (zerop power-now)
(let ((remaining (if (string= charging-state "Discharging")
energy-now
(- energy-full energy-now))))
- (setq hours (/ (/ (* remaining (string-to-number
- (match-string 1)))
- rate)
- 10000000.0)))))))
- (list (cons ?c (cond ((or (> charge-full 0) (> charge-now 0))
- (number-to-string charge-now))
- ((or (> energy-full 0) (> energy-now 0))
- (number-to-string energy-now))
+ (setq hours (/ remaining power-now)))))))
+ (list (cons ?c (cond ((or (> energy-full 0) (> energy-now 0))
+ (number-to-string (/ energy-now voltage-now)))
(t "N/A")))
- (cons ?r (if rate (format "%.1f" (/ rate 1000000.0)) "N/A"))
+ (cons ?r (if (> power-now 0.0)
+ (format "%.1f" (/ power-now 1000000.0))
+ "N/A"))
(cons ?m (if hours (format "%d" (* hours 60)) "N/A"))
(cons ?h (if hours (format "%d" hours) "N/A"))
(cons ?t (if hours
"N/A"))
(cons ?d (or temperature "N/A"))
(cons ?B (or charging-state "N/A"))
- (cons ?p (cond ((and (> charge-full 0) (> charge-now 0))
- (format "%.1f"
- (/ (* 100 charge-now) charge-full)))
- ((> energy-full 0)
+ (cons ?p (cond ((and (> energy-full 0) (> energy-now 0))
(format "%.1f"
(/ (* 100 energy-now) energy-full)))
(t "N/A")))
- (cons ?L (if (file-readable-p "/sys/class/power_supply/AC/online")
- (if (battery-search-for-one-match-in-files
- (list "/sys/class/power_supply/AC/online"
- "/sys/class/power_supply/ACAD/online")
- "1" 0)
- "AC"
- "BAT")
- "N/A")))))
+ (cons ?L (cond
+ ((battery-search-for-one-match-in-files
+ (list "/sys/class/power_supply/AC/online"
+ "/sys/class/power_supply/ACAD/online"
+ "/sys/class/power_supply/ADP1/online")
+ "1" 0)
+ "AC")
+ ((battery-search-for-one-match-in-files
+ (list "/sys/class/power_supply/AC/online"
+ "/sys/class/power_supply/ACAD/online"
+ "/sys/class/power_supply/ADP1/online")
+ "0" 0)
+ "BAT")
+ (t "N/A"))))))
\f
;;; `apm' interface for BSD.
(define-key esc-map "j" 'indent-new-comment-line)
(define-key esc-map "\C-j" 'indent-new-comment-line)
(define-key ctl-x-map ";" 'comment-set-column)
+(define-key ctl-x-map [?\C-\;] 'comment-line)
(define-key ctl-x-map "f" 'set-fill-column)
(define-key ctl-x-map "$" 'set-selective-display)
(save-selected-window
(pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
(delete-region (point-min) (point-max))
- (dolist (full-record bookmark-alist)
+ (dolist (full-record (bookmark-maybe-sort-alist))
(let* ((name (bookmark-name-from-full-record full-record))
(ann (bookmark-get-annotation full-record)))
(insert (concat name ":\n"))
Optional NOLOCATION non-nil means do not print the location."
(let ((l (solar-sunrise-sunset date)))
(format
- "%s, %s%s (%s hours daylight)"
+ "%s, %s%s (%s hrs daylight)"
(if (car l)
(concat "Sunrise " (apply 'solar-time-string (car l)))
"No sunrise")
(date (if (< arg 4) (calendar-current-date) (calendar-read-date)))
(date-string (calendar-date-string date t))
(time-string (solar-sunrise-sunset-string date))
- (msg (format "%s: %s" date-string time-string))
- (one-window (one-window-p t)))
- (if (<= (length msg) (frame-width))
- (message "%s" msg)
- (with-output-to-temp-buffer "*temp*"
- (princ (concat date-string "\n" time-string)))
- (message "%s"
- (substitute-command-keys
- (if one-window
- (if pop-up-windows
- "Type \\[delete-other-windows] to remove temp window."
- "Type \\[switch-to-buffer] RET to remove temp window.")
- "Type \\[switch-to-buffer-other-window] RET to restore old \
-contents of temp window."))))))
+ (msg (format "%s%s"
+ (if (< arg 4) "" ; don't print date if it's today's
+ (format "%s: " date-string))
+ time-string)))
+ (message "%s" msg)
+ msg))
;;;###cal-autoload
(defun calendar-sunrise-sunset (&optional event)
(goto-char (point-min))
(re-search-forward todo-done-string-start nil t)))
(buffer-read-only nil)
- item done-item opoint)
+ item done-item
+ (opoint (point)))
;; Don't add empty comment to done item.
(setq comment (unless (zerop (length comment))
(concat " [" todo-comment-string ": " comment "]")))
(todo-update-categories-sexp)
(let ((todo-show-with-done show-done))
(todo-category-select)
- ;; When done items are shown, put cursor on first just done item.
+ ;; When done items are visible, put point at the top of the
+ ;; done items section. When done items are hidden, restore
+ ;; point to its location prior to invoking this command.
(when opoint (goto-char opoint)))))))
(defun todo-item-undone ()
+2015-02-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes
+ * semantic/doc.el (semantic-documentation-comment-preceding-tag):
+ Rename from semantic-documentation-comment-preceeding-tag. All
+ uses changed. Leave an obsolete alias behind.
+
+2015-02-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * semantic/db-el.el (semanticdb-elisp-sym->tag): Fix copy&paste error
+ (semanticdb-project-database => sym). Avoid eieio--class-public-a
+ when possible.
+
+2015-02-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Use cl-generic instead of EIEIO's defgeneric/defmethod.
+ * **/*.el: Mechanically replace all calls to defmethod/defgeneric by
+ calls to cl-defmethod/cl-defgeneric.
+ * srecode/table.el:
+ * srecode/fields.el:
+ * srecode/dictionary.el:
+ * srecode/compile.el:
+ * semantic/debug.el:
+ * semantic/db-ref.el:
+ * ede/base.el:
+ * ede/auto.el:
+ * ede.el: Require `cl-generic'.
+
2015-01-07 Stefan Monnier <monnier@iro.umontreal.ca>
Don't use <class> as a variable and don't assume that <class>-list-p is
(require 'cedet)
(require 'eieio)
+(require 'cl-generic)
(require 'eieio-speedbar)
(require 'ede/source)
(require 'ede/base)
;;; Menu building methods for building
;;
-(defmethod ede-menu-items-build ((obj ede-project) &optional current)
+(cl-defmethod ede-menu-items-build ((obj ede-project) &optional current)
"Return a list of menu items for building project OBJ.
If optional argument CURRENT is non-nil, return sub-menu code."
(if current
(concat "Build Project " (ede-name obj))
`(project-compile-project ,obj))))))
-(defmethod ede-menu-items-build ((obj ede-target) &optional current)
+(cl-defmethod ede-menu-items-build ((obj ede-target) &optional current)
"Return a list of menu items for building target OBJ.
If optional argument CURRENT is non-nil, return sub-menu code."
(if current
;; Allert the user
(message "Project created and saved. You may now create targets."))
-(defmethod ede-add-subproject ((proj-a ede-project) proj-b)
+(cl-defmethod ede-add-subproject ((proj-a ede-project) proj-b)
"Add into PROJ-A, the subproject PROJ-B."
(oset proj-a subproj (cons proj-b (oref proj-a subproj))))
;; files should inherit from `ede-project'. Create the appropriate
;; methods based on those below.
-(defmethod project-interactive-select-target ((this ede-project-placeholder) prompt)
+(cl-defmethod project-interactive-select-target ((this ede-project-placeholder) prompt)
; checkdoc-params: (prompt)
"Make sure placeholder THIS is replaced with the real thing, and pass through."
(project-interactive-select-target this prompt))
-(defmethod project-interactive-select-target ((this ede-project) prompt)
+(cl-defmethod project-interactive-select-target ((this ede-project) prompt)
"Interactively query for a target that exists in project THIS.
Argument PROMPT is the prompt to use when querying the user for a target."
(let ((ob (object-assoc-list 'name (oref this targets))))
(cdr (assoc (completing-read prompt ob nil t) ob))))
-(defmethod project-add-file ((this ede-project-placeholder) file)
+(cl-defmethod project-add-file ((this ede-project-placeholder) file)
; checkdoc-params: (file)
"Make sure placeholder THIS is replaced with the real thing, and pass through."
(project-add-file this file))
-(defmethod project-add-file ((ot ede-target) file)
+(cl-defmethod project-add-file ((ot ede-target) file)
"Add the current buffer into project project target OT.
Argument FILE is the file to add."
(error "add-file not supported by %s" (eieio-object-name ot)))
-(defmethod project-remove-file ((ot ede-target) fnnd)
+(cl-defmethod project-remove-file ((ot ede-target) fnnd)
"Remove the current buffer from project target OT.
Argument FNND is an argument."
(error "remove-file not supported by %s" (eieio-object-name ot)))
-(defmethod project-edit-file-target ((ot ede-target))
+(cl-defmethod project-edit-file-target ((ot ede-target))
"Edit the target OT associated with this file."
(find-file (oref (ede-current-project) file)))
-(defmethod project-new-target ((proj ede-project) &rest args)
+(cl-defmethod project-new-target ((proj ede-project) &rest args)
"Create a new target. It is up to the project PROJ to get the name."
(error "new-target not supported by %s" (eieio-object-name proj)))
-(defmethod project-new-target-custom ((proj ede-project))
+(cl-defmethod project-new-target-custom ((proj ede-project))
"Create a new target. It is up to the project PROJ to get the name."
(error "New-target-custom not supported by %s" (eieio-object-name proj)))
-(defmethod project-delete-target ((ot ede-target))
+(cl-defmethod project-delete-target ((ot ede-target))
"Delete the current target OT from its parent project."
(error "add-file not supported by %s" (eieio-object-name ot)))
-(defmethod project-compile-project ((obj ede-project) &optional command)
+(cl-defmethod project-compile-project ((obj ede-project) &optional command)
"Compile the entire current project OBJ.
Argument COMMAND is the command to use when compiling."
(error "compile-project not supported by %s" (eieio-object-name obj)))
-(defmethod project-compile-target ((obj ede-target) &optional command)
+(cl-defmethod project-compile-target ((obj ede-target) &optional command)
"Compile the current target OBJ.
Argument COMMAND is the command to use for compiling the target."
(error "compile-target not supported by %s" (eieio-object-name obj)))
-(defmethod project-debug-target ((obj ede-target))
+(cl-defmethod project-debug-target ((obj ede-target))
"Run the current project target OBJ in a debugger."
(error "debug-target not supported by %s" (eieio-object-name obj)))
-(defmethod project-run-target ((obj ede-target))
+(cl-defmethod project-run-target ((obj ede-target))
"Run the current project target OBJ."
(error "run-target not supported by %s" (eieio-object-name obj)))
-(defmethod project-make-dist ((this ede-project))
+(cl-defmethod project-make-dist ((this ede-project))
"Build a distribution for the project based on THIS project."
(error "Make-dist not supported by %s" (eieio-object-name this)))
-(defmethod project-dist-files ((this ede-project))
+(cl-defmethod project-dist-files ((this ede-project))
"Return a list of files that constitute a distribution of THIS project."
(error "Dist-files is not supported by %s" (eieio-object-name this)))
-(defmethod project-rescan ((this ede-project))
+(cl-defmethod project-rescan ((this ede-project))
"Rescan the EDE project THIS."
(error "Rescanning a project is not supported by %s" (eieio-object-name this)))
;; Return our findings.
ede-object))
-(defmethod ede-target-in-project-p ((proj ede-project) target)
+(cl-defmethod ede-target-in-project-p ((proj ede-project) target)
"Is PROJ the parent of TARGET?
If TARGET belongs to a subproject, return that project file."
(if (and (slot-boundp proj 'targets)
projs (cdr projs)))
ans)))
-(defmethod ede-find-target ((proj ede-project) buffer)
+(cl-defmethod ede-find-target ((proj ede-project) buffer)
"Fetch the target in PROJ belonging to BUFFER or nil."
(with-current-buffer buffer
(setq targets (cdr targets)))
f)))))
-(defmethod ede-target-buffer-in-sourcelist ((this ede-target) buffer source)
+(cl-defmethod ede-target-buffer-in-sourcelist ((this ede-target) buffer source)
"Return non-nil if object THIS is in BUFFER to a SOURCE list.
Handles complex path issues."
(member (ede-convert-path this (buffer-file-name buffer)) source))
-(defmethod ede-buffer-mine ((this ede-project) buffer)
+(cl-defmethod ede-buffer-mine ((this ede-project) buffer)
"Return non-nil if object THIS lays claim to the file in BUFFER."
nil)
-(defmethod ede-buffer-mine ((this ede-target) buffer)
+(cl-defmethod ede-buffer-mine ((this ede-target) buffer)
"Return non-nil if object THIS lays claim to the file in BUFFER."
(condition-case nil
(ede-target-buffer-in-sourcelist this buffer (oref this source))
"Execute PROC on all buffers controlled by EDE."
(mapcar proc (ede-buffers)))
-(defmethod ede-map-project-buffers ((this ede-project) proc)
+(cl-defmethod ede-map-project-buffers ((this ede-project) proc)
"For THIS, execute PROC on all buffers belonging to THIS."
(mapcar proc (ede-project-buffers this)))
-(defmethod ede-map-target-buffers ((this ede-target) proc)
+(cl-defmethod ede-map-target-buffers ((this ede-target) proc)
"For THIS, execute PROC on all buffers belonging to THIS."
(mapcar proc (ede-target-buffers this)))
;; other types of mapping
-(defmethod ede-map-subprojects ((this ede-project) proc)
+(cl-defmethod ede-map-subprojects ((this ede-project) proc)
"For object THIS, execute PROC on all direct subprojects.
This function does not apply PROC to sub-sub projects.
See also `ede-map-all-subprojects'."
(mapcar proc (oref this subproj)))
-(defmethod ede-map-all-subprojects ((this ede-project) allproc)
+(cl-defmethod ede-map-all-subprojects ((this ede-project) allproc)
"For object THIS, execute PROC on THIS and all subprojects.
This function also applies PROC to sub-sub projects.
See also `ede-map-subprojects'."
;; (ede-map-all-subprojects (ede-load-project-file "../semantic/") (lambda (sp) (oref sp file)))
-(defmethod ede-map-targets ((this ede-project) proc)
+(cl-defmethod ede-map-targets ((this ede-project) proc)
"For object THIS, execute PROC on all targets."
(mapcar proc (oref this targets)))
-(defmethod ede-map-any-target-p ((this ede-project) proc)
+(cl-defmethod ede-map-any-target-p ((this ede-project) proc)
"For project THIS, map PROC to all targets and return if any non-nil.
Return the first non-nil value returned by PROC."
(eval (cons 'or (ede-map-targets this proc))))
;; configuring items for Semantic.
;; Generic paths
-(defmethod ede-system-include-path ((this ede-project))
+(cl-defmethod ede-system-include-path ((this ede-project))
"Get the system include path used by project THIS."
nil)
-(defmethod ede-system-include-path ((this ede-target))
+(cl-defmethod ede-system-include-path ((this ede-target))
"Get the system include path used by project THIS."
nil)
-(defmethod ede-source-paths ((this ede-project) mode)
+(cl-defmethod ede-source-paths ((this ede-project) mode)
"Get the base to all source trees in the current project for MODE.
For example, <root>/src for sources of c/c++, Java, etc,
and <root>/doc for doc sources."
(message "Choosing preprocessor syms for project %s"
(eieio-object-name (car objs)))))))
-(defmethod ede-system-include-path ((this ede-project))
+(cl-defmethod ede-system-include-path ((this ede-project))
"Get the system include path used by project THIS."
nil)
-(defmethod ede-preprocessor-map ((this ede-project))
+(cl-defmethod ede-preprocessor-map ((this ede-project))
"Get the pre-processor map for project THIS."
nil)
-(defmethod ede-preprocessor-map ((this ede-target))
+(cl-defmethod ede-preprocessor-map ((this ede-target))
"Get the pre-processor map for project THIS."
nil)
;; Java
-(defmethod ede-java-classpath ((this ede-project))
+(cl-defmethod ede-java-classpath ((this ede-project))
"Return the classpath for this project."
;; @TODO - Can JDEE add something here?
nil)
(error "Cannot set project variable until it is added with `ede-make-project-local-variable'"))
(setcdr va value)))
-(defmethod ede-set-project-variables ((project ede-project) &optional buffer)
+(cl-defmethod ede-set-project-variables ((project ede-project) &optional buffer)
"Set variables local to PROJECT in BUFFER."
(if (not buffer) (setq buffer (current-buffer)))
(with-current-buffer buffer
(make-local-variable (car v))
(set (car v) (cdr v)))))
-(defmethod ede-commit-local-variables ((proj ede-project))
+(cl-defmethod ede-commit-local-variables ((proj ede-project))
"Commit change to local variables in PROJ."
nil)
;;; Code:
(require 'eieio)
+(require 'cl-generic)
(declare-function ede-directory-safe-p "ede")
(declare-function ede-add-project-to-global-list "ede")
can be used to define that match without loading the specific project
into memory.")
-(defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch))
+(cl-defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch))
"Return non-nil if the tool DIRMATCH might match is installed on the system."
(let ((fc (oref dirmatch fromconfig)))
(t (error "Unknown dirmatch type.")))))
-(defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file)
+(cl-defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file)
"Does DIRMATCH match the filename FILE."
(let ((fc (oref dirmatch fromconfig)))
;;
;; New method using detect.el
-(defmethod ede-auto-detect-in-dir ((this ede-project-autoload) dir)
+(cl-defmethod ede-auto-detect-in-dir ((this ede-project-autoload) dir)
"Return non-nil if THIS project autoload is found in DIR."
(let* ((d (file-name-as-directory dir))
(pf (oref this proj-file))
;(message "Dirmatch %S not installed." dirmatch)
)))))))
-(defmethod ede-auto-load-project ((this ede-project-autoload) dir)
+(cl-defmethod ede-auto-load-project ((this ede-project-autoload) dir)
"Load in the project associated with THIS project autoload description.
THIS project description should be valid for DIR, where the project will
be loaded.
;; See if we can do without them.
;; @FIXME - delete from loaddefs to remove this.
-(defmethod ede-project-root ((this ede-project-autoload))
+(cl-defmethod ede-project-root ((this ede-project-autoload))
"If a project knows its root, return it here.
Allows for one-project-object-for-a-tree type systems."
nil)
;; @FIXME - delete from loaddefs to remove this.
-(defmethod ede-project-root-directory ((this ede-project-autoload) &optional file)
+(cl-defmethod ede-project-root-directory ((this ede-project-autoload) &optional file)
"" nil)
(provide 'ede/auto)
;;; Code:
(require 'eieio)
+(require 'cl-generic)
(require 'eieio-speedbar)
(require 'ede/auto)
;;
;; Mode related methods are in ede.el. These methods are related
;; project specific activities not directly tied to a keybinding.
-(defmethod ede-subproject-relative-path ((proj ede-project) &optional parent-in)
+(cl-defmethod ede-subproject-relative-path ((proj ede-project) &optional parent-in)
"Get a path name for PROJ which is relative to the parent project.
If PARENT is specified, then be relative to the PARENT project.
Specifying PARENT is useful for sub-sub projects relative to the root project."
(file-relative-name dir (file-name-directory (oref parent file)))
"")))
-(defmethod ede-subproject-p ((proj ede-project))
+(cl-defmethod ede-subproject-p ((proj ede-project))
"Return non-nil if PROJ is a sub project."
;; @TODO - Use this in more places, and also pay attention to
;; metasubproject in ede/proj.el
;; no need to in most situations because they are either a) simple, or
;; b) cosmetic.
-(defmethod ede-name ((this ede-target))
+(cl-defmethod ede-name ((this ede-target))
"Return the name of THIS target."
(oref this name))
-(defmethod ede-target-name ((this ede-target))
+(cl-defmethod ede-target-name ((this ede-target))
"Return the name of THIS target, suitable for make or debug style commands."
(oref this name))
-(defmethod ede-name ((this ede-project))
+(cl-defmethod ede-name ((this ede-project))
"Return a short-name for THIS project file.
Do this by extracting the lowest directory name."
(oref this name))
-(defmethod ede-description ((this ede-project))
+(cl-defmethod ede-description ((this ede-project))
"Return a description suitable for the minibuffer about THIS."
(format "Project %s: %d subprojects, %d targets."
(ede-name this) (length (oref this subproj))
(length (oref this targets))))
-(defmethod ede-description ((this ede-target))
+(cl-defmethod ede-description ((this ede-target))
"Return a description suitable for the minibuffer about THIS."
(format "Target %s: with %d source files."
(ede-name this) (length (oref this source))))
(ede-buffer-header-file ede-object (current-buffer))
nil))
-(defmethod ede-buffer-header-file ((this ede-project) buffer)
+(cl-defmethod ede-buffer-header-file ((this ede-project) buffer)
"Return nil, projects don't have header files."
nil)
-(defmethod ede-buffer-header-file ((this ede-target) buffer)
+(cl-defmethod ede-buffer-header-file ((this ede-target) buffer)
"There are no default header files in EDE.
Do a quick check to see if there is a Header tag in this buffer."
(with-current-buffer buffer
(ede-buffer-documentation-files ede-object (current-buffer))
nil))
-(defmethod ede-buffer-documentation-files ((this ede-project) buffer)
+(cl-defmethod ede-buffer-documentation-files ((this ede-project) buffer)
"Return all documentation in project THIS based on BUFFER."
;; Find the info node.
(ede-documentation this))
-(defmethod ede-buffer-documentation-files ((this ede-target) buffer)
+(cl-defmethod ede-buffer-documentation-files ((this ede-target) buffer)
"Check for some documentation files for THIS.
Also do a quick check to see if there is a Documentation tag in this BUFFER."
(with-current-buffer buffer
(let ((cp (ede-toplevel)))
(ede-buffer-documentation-files cp (current-buffer))))))
-(defmethod ede-documentation ((this ede-project))
+(cl-defmethod ede-documentation ((this ede-project))
"Return a list of files that provide documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
proj (cdr proj)))
found))
-(defmethod ede-documentation ((this ede-target))
+(cl-defmethod ede-documentation ((this ede-target))
"Return a list of files that provide documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
(ede-html-documentation (ede-toplevel))
)
-(defmethod ede-html-documentation ((this ede-project))
+(cl-defmethod ede-html-documentation ((this ede-project))
"Return a list of HTML files provided by project THIS."
)
;; These methods are used to determine if a target "wants", or could
;; somehow handle a file, or some source type.
;;
-(defmethod ede-want-file-p ((this ede-target) file)
+(cl-defmethod ede-want-file-p ((this ede-target) file)
"Return non-nil if THIS target wants FILE."
;; By default, all targets reference the source object, and let it decide.
(let ((src (ede-target-sourcecode this)))
(setq src (cdr src)))
src))
-(defmethod ede-want-file-source-p ((this ede-target) file)
+(cl-defmethod ede-want-file-source-p ((this ede-target) file)
"Return non-nil if THIS target wants FILE."
;; By default, all targets reference the source object, and let it decide.
(let ((src (ede-target-sourcecode this)))
(setq src (cdr src)))
src))
-(defmethod ede-target-sourcecode ((this ede-target))
+(cl-defmethod ede-target-sourcecode ((this ede-target))
"Return the sourcecode objects which THIS permits."
(let ((sc (oref this sourcetype))
(rs nil))
;;; Rescanning
-(defmethod project-rescan ((this ede-project-with-config))
+(cl-defmethod project-rescan ((this ede-project-with-config))
"Rescan this generic project from the sources."
;; Force the config to be rescanned.
(oset this config nil)
;;; Project Methods for configuration
-(defmethod ede-config-get-configuration ((proj ede-project-with-config) &optional loadask)
+(cl-defmethod ede-config-get-configuration ((proj ede-project-with-config) &optional loadask)
"Return the configuration for the project PROJ.
If optional LOADASK is non-nil, then if a project file exists, and if
the directory isn't on the `safe' list, ask to add it to the safe list."
(oset config project proj)))
config))
-(defmethod ede-config-setup-configuration ((proj ede-project-with-config) config)
+(cl-defmethod ede-config-setup-configuration ((proj ede-project-with-config) config)
"Default configuration setup method."
nil)
-(defmethod ede-commit-project ((proj ede-project-with-config))
+(cl-defmethod ede-commit-project ((proj ede-project-with-config))
"Commit any change to PROJ to its file."
(let ((config (ede-config-get-configuration proj)))
(ede-commit config)))
;;; Customization
;;
-(defmethod ede-customize ((proj ede-project-with-config))
+(cl-defmethod ede-customize ((proj ede-project-with-config))
"Customize the EDE project PROJ by actually configuring the config object."
(let ((config (ede-config-get-configuration proj t)))
(eieio-customize-object config)))
-(defmethod ede-customize ((target ede-target-with-config))
+(cl-defmethod ede-customize ((target ede-target-with-config))
"Customize the EDE TARGET by actually configuring the config object."
;; Nothing unique for the targets, use the project.
(ede-customize-project))
-(defmethod eieio-done-customizing ((config ede-extra-config))
+(cl-defmethod eieio-done-customizing ((config ede-extra-config))
"Called when EIEIO is done customizing the configuration object.
We need to go back through the old buffers, and update them with
the new configuration."
(with-current-buffer b
(ede-apply-target-options)))))))
-(defmethod ede-commit ((config ede-extra-config))
+(cl-defmethod ede-commit ((config ede-extra-config))
"Commit all changes to the configuration to disk."
;; So long as the user is trying to safe this config, make sure they can
;; get at it again later.
This class brings in method overloads for running and debugging
programs from a project.")
-(defmethod project-debug-target ((target ede-target-with-config-program))
+(cl-defmethod project-debug-target ((target ede-target-with-config-program))
"Run the current project derived from TARGET in a debugger."
(let* ((proj (ede-target-parent target))
(config (ede-config-get-configuration proj t))
(cmdsym (intern-soft (car cmdsplit))))
(call-interactively cmdsym t)))
-(defmethod project-run-target ((target ede-target-with-config-program))
+(cl-defmethod project-run-target ((target ede-target-with-config-program))
"Run the current project derived from TARGET."
(let* ((proj (ede-target-parent target))
(config (ede-config-get-configuration proj t))
"Class to mix into a project with configuration for builds.
This class brings in method overloads for for building.")
-(defmethod project-compile-project ((proj ede-project-with-config-build) &optional command)
+(cl-defmethod project-compile-project ((proj ede-project-with-config-build) &optional command)
"Compile the entire current project PROJ.
Argument COMMAND is the command to use when compiling."
(let* ((config (ede-config-get-configuration proj t))
(comp (oref config :build-command)))
(compile comp)))
-(defmethod project-compile-target ((obj ede-target-with-config-build) &optional command)
+(cl-defmethod project-compile-target ((obj ede-target-with-config-build) &optional command)
"Compile the current target OBJ.
Argument COMMAND is the command to use for compiling the target."
(project-compile-project (ede-current-project) command))
This target brings in methods used by Semantic to query
the preprocessor map, and include paths.")
-(defmethod ede-preprocessor-map ((this ede-target-with-config-c))
+(cl-defmethod ede-preprocessor-map ((this ede-target-with-config-c))
"Get the pre-processor map for some generic C code."
(let* ((proj (ede-target-parent this))
(root (ede-project-root proj))
filemap
))
-(defmethod ede-system-include-path ((this ede-target-with-config-c))
+(cl-defmethod ede-system-include-path ((this ede-target-with-config-c))
"Get the system include path used by project THIS."
(let* ((proj (ede-target-parent this))
(config (ede-config-get-configuration proj)))
()
"Class to mix into a project to support java.")
-(defmethod ede-java-classpath ((proj ede-project-with-config-java))
+(cl-defmethod ede-java-classpath ((proj ede-project-with-config-java))
"Return the classpath for this project."
(oref (ede-config-get-configuration proj) :classpath))
;; find previous copies of this project, and make sure that one of the
;; objects is deleted.
-(defmethod initialize-instance ((this ede-cpp-root-project)
+(cl-defmethod initialize-instance ((this ede-cpp-root-project)
&rest fields)
"Make sure the :file is fully expanded."
;; Add ourselves to the master list
- (call-next-method)
+ (cl-call-next-method)
(let ((f (expand-file-name (oref this :file))))
;; Remove any previous entries from the main list.
(let ((old (eieio-instance-tracker-find (file-name-directory f)
;; This is a way to allow a subdirectory to point back to the root
;; project, simplifying authoring new single-point projects.
-(defmethod ede-find-subproject-for-directory ((proj ede-cpp-root-project)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-cpp-root-project)
dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
;; Creating new targets on a per directory basis is a good way to keep
;; files organized. See ede-emacs for an example with multiple file
;; types.
-(defmethod ede-find-target ((proj ede-cpp-root-project) buffer)
+(cl-defmethod ede-find-target ((proj ede-cpp-root-project) buffer)
"Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory."
(let* ((targets (oref proj targets))
;;
;; This tools also uses the ede-locate setup for augmented file name
;; lookup using external tools.
-(defmethod ede-expand-filename-impl ((proj ede-cpp-root-project) name)
+(cl-defmethod ede-expand-filename-impl ((proj ede-cpp-root-project) name)
"Within this project PROJ, find the file NAME.
This knows details about or source tree."
;; The slow part of the original is looping over subprojects.
;; This version has no subprojects, so this will handle some
;; basic cases.
- (let ((ans (call-next-method)))
+ (let ((ans (cl-call-next-method)))
(unless ans
(let* ((lf (oref proj locate-fcn))
(dir (file-name-directory (oref proj file))))
(setq ans tmp))
(setq ip (cdr ip)) ))
;; Else, do the usual.
- (setq ans (call-next-method)))
+ (setq ans (cl-call-next-method)))
)))
;; TODO - does this call-next-method happen twice. Is that bad?? Why is it here?
- (or ans (call-next-method))))
+ (or ans (cl-call-next-method))))
-(defmethod ede-project-root ((this ede-cpp-root-project))
+(cl-defmethod ede-project-root ((this ede-cpp-root-project))
"Return my root."
this)
-(defmethod ede-project-root-directory ((this ede-cpp-root-project))
+(cl-defmethod ede-project-root-directory ((this ede-cpp-root-project))
"Return my root."
(oref this directory))
;; The following code is specific to setting up header files,
;; include lists, and Preprocessor symbol tables.
-(defmethod ede-cpp-root-header-file-p ((proj ede-cpp-root-project) name)
+(cl-defmethod ede-cpp-root-header-file-p ((proj ede-cpp-root-project) name)
"Non nil if in PROJ the filename NAME is a header."
(save-match-data
(string-match (oref proj header-match-regexp) name)))
-(defmethod ede-cpp-root-translate-file ((proj ede-cpp-root-project) filename)
+(cl-defmethod ede-cpp-root-translate-file ((proj ede-cpp-root-project) filename)
"For PROJ, translate a user specified FILENAME.
This is for project include paths and spp source files."
;; Step one: Root of this project.
filename))
-(defmethod ede-system-include-path ((this ede-cpp-root-project))
+(cl-defmethod ede-system-include-path ((this ede-cpp-root-project))
"Get the system include path used by project THIS."
(oref this system-include-path))
-(defmethod ede-preprocessor-map ((this ede-cpp-root-project))
+(cl-defmethod ede-preprocessor-map ((this ede-cpp-root-project))
"Get the pre-processor map for project THIS."
(require 'semantic/db)
(let ((spp (oref this spp-table))
(oref this spp-files))
spp))
-(defmethod ede-system-include-path ((this ede-cpp-root-target))
+(cl-defmethod ede-system-include-path ((this ede-cpp-root-target))
"Get the system include path used by target THIS."
(ede-system-include-path (ede-target-parent this)))
-(defmethod ede-preprocessor-map ((this ede-cpp-root-target))
+(cl-defmethod ede-preprocessor-map ((this ede-cpp-root-target))
"Get the pre-processor map for project THIS."
(ede-preprocessor-map (ede-target-parent this)))
-(defmethod project-compile-project ((proj ede-cpp-root-project) &optional command)
+(cl-defmethod project-compile-project ((proj ede-cpp-root-project) &optional command)
"Compile the entire current project PROJ.
Argument COMMAND is the command to use when compiling."
;; we need to be in the proj root dir for this to work
(let ((default-directory (ede-project-root-directory proj)))
(compile cmd-str)))))
-(defmethod project-compile-target ((obj ede-cpp-root-target) &optional command)
+(cl-defmethod project-compile-target ((obj ede-cpp-root-target) &optional command)
"Compile the current target OBJ.
Argument COMMAND is the command to use for compiling the target."
(when (oref obj :project)
(project-compile-project (oref obj :project) command)))
-(defmethod project-rescan ((this ede-cpp-root-project))
+(cl-defmethod project-rescan ((this ede-cpp-root-project))
"Don't rescan this project from the sources."
(message "cpp-root has nothing to rescan."))
(error "No logical target to customize"))
(ede-customize obj))
-(defmethod ede-customize ((proj ede-project))
+(cl-defmethod ede-customize ((proj ede-project))
"Customize the EDE project PROJ."
(eieio-customize-object proj 'default))
-(defmethod ede-customize ((target ede-target))
+(cl-defmethod ede-customize ((target ede-target))
"Customize the EDE TARGET."
(eieio-customize-object target 'default))
;;; Customization hooks
;;
;; These hooks are used when finishing up a customization.
-(defmethod eieio-done-customizing ((proj ede-project))
+(cl-defmethod eieio-done-customizing ((proj ede-project))
"Call this when a user finishes customizing PROJ."
(let ((ov eieio-ede-old-variables)
(nv (oref proj local-variables)))
;; These two methods should be implemented by subclasses of
;; project and targets in order to account for user specified
;; changes.
-(defmethod eieio-done-customizing ((target ede-target))
+(cl-defmethod eieio-done-customizing ((target ede-target))
"Call this when a user finishes customizing TARGET."
nil)
-(defmethod ede-commit-project ((proj ede-project))
+(cl-defmethod ede-commit-project ((proj ede-project))
"Commit any change to PROJ to its file."
nil
)
"EDE Emacs Project target for Misc files.
All directories need at least one target.")
-(defmethod initialize-instance ((this ede-emacs-project)
+(cl-defmethod initialize-instance ((this ede-emacs-project)
&rest fields)
"Make sure the targets slot is bound."
- (call-next-method)
+ (cl-call-next-method)
(unless (slot-boundp this 'targets)
(oset this :targets nil)))
;;; File Stuff
;;
-(defmethod ede-project-root-directory ((this ede-emacs-project)
+(cl-defmethod ede-project-root-directory ((this ede-emacs-project)
&optional file)
"Return the root for THIS Emacs project with file."
(ede-up-directory (file-name-directory (oref this file))))
-(defmethod ede-project-root ((this ede-emacs-project))
+(cl-defmethod ede-project-root ((this ede-emacs-project))
"Return my root."
this)
-(defmethod ede-find-subproject-for-directory ((proj ede-emacs-project)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-emacs-project)
dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
))
match))
-(defmethod ede-find-target ((proj ede-emacs-project) buffer)
+(cl-defmethod ede-find-target ((proj ede-emacs-project) buffer)
"Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory."
(let* ((ext (file-name-extension (buffer-file-name buffer)))
;;; UTILITIES SUPPORT.
;;
-(defmethod ede-preprocessor-map ((this ede-emacs-target-c))
+(cl-defmethod ede-preprocessor-map ((this ede-emacs-target-c))
"Get the pre-processor map for Emacs C code.
All files need the macros from lisp.h!"
(require 'semantic/db)
(setq dirs (cdr dirs))))
ans))
-(defmethod ede-expand-filename-impl ((proj ede-emacs-project) name)
+(cl-defmethod ede-expand-filename-impl ((proj ede-emacs-project) name)
"Within this project PROJ, find the file NAME.
Knows about how the Emacs source tree is organized."
(let* ((ext (file-name-extension name))
'("doc"))
(t nil)))
)
- (if (not dirs) (call-next-method)
+ (if (not dirs) (cl-call-next-method)
(ede-emacs-find-in-directories name dir dirs))
))
;;; Command Support
;;
-(defmethod project-rescan ((this ede-emacs-project))
+(cl-defmethod project-rescan ((this ede-emacs-project))
"Rescan this Emacs project from the sources."
(let ((ver (ede-emacs-version (ede-project-root-directory this))))
(oset this name (car ver))
;;; Placeholders for ROOT directory scanning on base objects
;;
-(defmethod ede-project-root ((this ede-project-placeholder))
+(cl-defmethod ede-project-root ((this ede-project-placeholder))
"If a project knows its root, return it here.
Allows for one-project-object-for-a-tree type systems."
(oref this rootproject))
-(defmethod ede-project-root-directory ((this ede-project-placeholder)
+(cl-defmethod ede-project-root-directory ((this ede-project-placeholder)
&optional file)
"If a project knows its root, return it here.
Allows for one-project-object-for-a-tree type systems.
(ede--put-inode-dir-hash dir (nth 10 fattr))
)))))
-(defmethod ede--project-inode ((proj ede-project-placeholder))
+(cl-defmethod ede--project-inode ((proj ede-project-placeholder))
"Get the inode of the directory project PROJ is in."
(if (slot-boundp proj 'dirinode)
(oref proj dirinode)
;; the short answer we found -> ie - we are in a subproject.
(or ans shortans)))
-(defmethod ede-find-subproject-for-directory ((proj ede-project-placeholder)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-project-placeholder)
dir)
"Find a subproject of PROJ that corresponds to DIR."
(if ede--disable-inode
;;; DIRECTORY CONVERSION STUFF
;;
-(defmethod ede-convert-path ((this ede-project) path)
+(cl-defmethod ede-convert-path ((this ede-project) path)
"Convert path in a standard way for a given project.
Default to making it project relative.
Argument THIS is the project to convert PATH to."
(substring fptf (match-end 0))
(error "Cannot convert relativize path %s" fp))))))
-(defmethod ede-convert-path ((this ede-target) path &optional project)
+(cl-defmethod ede-convert-path ((this ede-target) path &optional project)
"Convert path in a standard way for a given project.
Default to making it project relative.
Argument THIS is the project to convert PATH to.
(oref top locate-obj)
)))
-(defmethod ede-expand-filename ((this ede-project) filename &optional force)
+(cl-defmethod ede-expand-filename ((this ede-project) filename &optional force)
"Return a fully qualified file name based on project THIS.
FILENAME should be just a filename which occurs in a directory controlled
by this project.
ans))
-(defmethod ede-expand-filename-impl ((this ede-project) filename &optional force)
+(cl-defmethod ede-expand-filename-impl ((this ede-project) filename &optional force)
"Return a fully qualified file name based on project THIS.
FILENAME should be just a filename which occurs in a directory controlled
by this project.
;; Return it
found))
-(defmethod ede-expand-filename-local ((this ede-project) filename)
+(cl-defmethod ede-expand-filename-local ((this ede-project) filename)
"Expand filename locally to project THIS with filesystem tests."
(let ((path (ede-project-root-directory this)))
(cond ((file-exists-p (expand-file-name filename path))
((file-exists-p (expand-file-name (concat "include/" filename) path))
(expand-file-name (concat "include/" filename) path)))))
-(defmethod ede-expand-filename-impl-via-subproj ((this ede-project) filename)
+(cl-defmethod ede-expand-filename-impl-via-subproj ((this ede-project) filename)
"Return a fully qualified file name based on project THIS.
FILENAME should be just a filename which occurs in a directory controlled
by this project."
;; Return it
found))
-(defmethod ede-expand-filename ((this ede-target) filename &optional force)
+(cl-defmethod ede-expand-filename ((this ede-target) filename &optional force)
"Return a fully qualified file name based on target THIS.
FILENAME should be a filename which occurs in a directory in which THIS works.
Optional argument FORCE forces the default filename to be provided even if it
"The baseclass for all generic EDE project types."
:abstract t)
-(defmethod initialize-instance ((this ede-generic-project)
+(cl-defmethod initialize-instance ((this ede-generic-project)
&rest fields)
"Make sure the targets slot is bound."
- (call-next-method)
+ (cl-call-next-method)
(unless (slot-boundp this 'targets)
(oset this :targets nil))
)
-(defmethod ede-project-root ((this ede-generic-project))
+(cl-defmethod ede-project-root ((this ede-generic-project))
"Return my root."
this)
-(defmethod ede-find-subproject-for-directory ((proj ede-generic-project)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-generic-project)
dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
))
match))
-(defmethod ede-find-target ((proj ede-generic-project) buffer)
+(cl-defmethod ede-find-target ((proj ede-generic-project) buffer)
"Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory."
(let* ((ext (file-name-extension (buffer-file-name buffer)))
)
"Generic Project for makefiles.")
-(defmethod ede-generic-setup-configuration ((proj ede-generic-makefile-project) config)
+(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-makefile-project) config)
"Setup a configuration for Make."
(oset config build-command "make -k")
(oset config debug-command "gdb ")
)
"Generic Project for scons.")
-(defmethod ede-generic-setup-configuration ((proj ede-generic-scons-project) config)
+(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-scons-project) config)
"Setup a configuration for SCONS."
(oset config build-command "scons")
(oset config debug-command "gdb ")
)
"Generic Project for cmake.")
-(defmethod ede-generic-setup-configuration ((proj ede-generic-cmake-project) config)
+(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-cmake-project) config)
"Setup a configuration for CMake."
(oset config build-command "cmake")
(oset config debug-command "gdb ")
()
"Generic project found via Version Control files.")
-(defmethod ede-generic-setup-configuration ((proj ede-generic-vc-project) config)
+(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-vc-project) config)
"Setup a configuration for projects identified by revision control."
)
"EDE Linux Project target for Misc files.
All directories need at least one target.")
-(defmethod initialize-instance ((this ede-linux-project)
+(cl-defmethod initialize-instance ((this ede-linux-project)
&rest fields)
"Make sure the targets slot is bound."
- (call-next-method)
+ (cl-call-next-method)
(unless (slot-boundp this 'targets)
(oset this :targets nil)))
;;; File Stuff
;;
-(defmethod ede-project-root-directory ((this ede-linux-project)
+(cl-defmethod ede-project-root-directory ((this ede-linux-project)
&optional file)
"Return the root for THIS Linux project with file."
(ede-up-directory (file-name-directory (oref this file))))
-(defmethod ede-project-root ((this ede-linux-project))
+(cl-defmethod ede-project-root ((this ede-linux-project))
"Return my root."
this)
-(defmethod ede-find-subproject-for-directory ((proj ede-linux-project)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-linux-project)
dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
))
match))
-(defmethod ede-find-target ((proj ede-linux-project) buffer)
+(cl-defmethod ede-find-target ((proj ede-linux-project) buffer)
"Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory."
(let* ((ext (file-name-extension (buffer-file-name buffer)))
;;; UTILITIES SUPPORT.
;;
-(defmethod ede-preprocessor-map ((this ede-linux-target-c))
+(cl-defmethod ede-preprocessor-map ((this ede-linux-target-c))
"Get the pre-processor map for Linux C code.
All files need the macros from lisp.h!"
(require 'semantic/db)
(let ((F (expand-file-name name (expand-file-name subdir root))))
(when (file-exists-p F) F)))
-(defmethod ede-expand-filename-impl ((proj ede-linux-project) name)
+(cl-defmethod ede-expand-filename-impl ((proj ede-linux-project) name)
"Within this project PROJ, find the file NAME.
Knows about how the Linux source tree is organized."
(let* ((ext (file-name-extension name))
((string-match "txt" ext)
(ede-linux-file-exists-name name dir "Documentation"))
(t nil))))
- (or F (call-next-method))))
+ (or F (cl-call-next-method))))
;;; Command Support
;;
-(defmethod project-compile-project ((proj ede-linux-project)
+(cl-defmethod project-compile-project ((proj ede-linux-project)
&optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
(compile command)))
-(defmethod project-compile-target ((obj ede-linux-target-c) &optional command)
+(cl-defmethod project-compile-target ((obj ede-linux-target-c) &optional command)
"Compile the current target.
Argument COMMAND is the command to use for compiling the target."
(let* ((proj (ede-target-parent obj))
(compile command)))
-(defmethod project-rescan ((this ede-linux-project))
+(cl-defmethod project-rescan ((this ede-linux-project))
"Rescan this Linux project from the sources."
(let* ((dir (ede-project-root-directory this))
(bdir (ede-linux--get-build-directory dir))
)
"Baseclass for LOCATE feature in EDE.")
-(defmethod initialize-instance ((loc ede-locate-base) &rest fields)
+(cl-defmethod initialize-instance ((loc ede-locate-base) &rest fields)
"Make sure we have a hash table."
;; Basic setup.
- (call-next-method)
+ (cl-call-next-method)
;; Make sure we have a hash table.
(ede-locate-flush-hash loc)
)
-(defmethod ede-locate-ok-in-project :static ((loc ede-locate-base)
+(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-base))
root)
"Is it ok to use this project type under ROOT."
t)
-(defmethod ede-locate-flush-hash ((loc ede-locate-base))
+(cl-defmethod ede-locate-flush-hash ((loc ede-locate-base))
"For LOC, flush hashtable and start from scratch."
(oset loc hash (make-hash-table :test 'equal)))
-(defmethod ede-locate-file-in-hash ((loc ede-locate-base)
+(cl-defmethod ede-locate-file-in-hash ((loc ede-locate-base)
filestring)
"For LOC, is the file FILESTRING in our hashtable?"
(gethash filestring (oref loc hash)))
-(defmethod ede-locate-add-file-to-hash ((loc ede-locate-base)
+(cl-defmethod ede-locate-add-file-to-hash ((loc ede-locate-base)
filestring fullfilename)
"For LOC, add FILESTR to the hash with FULLFILENAME."
(puthash filestring fullfilename (oref loc hash)))
-(defmethod ede-locate-file-in-project ((loc ede-locate-base)
+(cl-defmethod ede-locate-file-in-project ((loc ede-locate-base)
filesubstring
)
"Locate with LOC occurrences of FILESUBSTRING.
(oset loc lastanswer ans)
ans))
-(defmethod ede-locate-file-in-project-impl ((loc ede-locate-base)
+(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-base)
filesubstring
)
"Locate with LOC occurrences of FILESUBSTRING.
nil
)
-(defmethod ede-locate-create/update-root-database :STATIC
- ((loc ede-locate-base) root)
+(cl-defmethod ede-locate-create/update-root-database
+ ((loc (subclass ede-locate-base)) root)
"Create or update the database for the current project.
You cannot create projects for the baseclass."
(error "Cannot create/update a database of type %S"
Configure the Emacs `locate-program' variable to also
configure the use of EDE locate.")
-(defmethod ede-locate-ok-in-project :static ((loc ede-locate-locate)
+(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-locate))
root)
"Is it ok to use this project type under ROOT."
(or (featurep 'locate) (locate-library "locate"))
)
-(defmethod ede-locate-file-in-project-impl ((loc ede-locate-locate)
+(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-locate)
filesubstring)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project
Configure EDE's use of GNU Global through the cedet-global.el
variable `cedet-global-command'.")
-(defmethod initialize-instance ((loc ede-locate-global)
+(cl-defmethod initialize-instance ((loc ede-locate-global)
&rest slots)
"Make sure that we can use GNU Global."
(require 'cedet-global)
;; Get ourselves initialized.
- (call-next-method)
+ (cl-call-next-method)
;; Do the checks.
(cedet-gnu-global-version-check)
(let* ((default-directory (oref loc root))
(oref loc root))))
)
-(defmethod ede-locate-ok-in-project :static ((loc ede-locate-global)
+(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-global))
root)
"Is it ok to use this project type under ROOT."
(require 'cedet-global)
(newroot (cedet-gnu-global-root)))
newroot))
-(defmethod ede-locate-file-in-project-impl ((loc ede-locate-global)
+(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-global)
filesubstring)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project
(let ((default-directory (oref loc root)))
(cedet-gnu-global-expand-filename filesubstring)))
-(defmethod ede-locate-create/update-root-database :STATIC
- ((loc ede-locate-global) root)
+(cl-defmethod ede-locate-create/update-root-database
+ ((loc (subclass ede-locate-global)) root)
"Create or update the GNU Global database for the current project."
(cedet-gnu-global-create/update-database root))
Configure EDE's use of IDUtils through the cedet-idutils.el
file name searching variable `cedet-idutils-file-command'.")
-(defmethod initialize-instance ((loc ede-locate-idutils)
+(cl-defmethod initialize-instance ((loc ede-locate-idutils)
&rest slots)
"Make sure that we can use IDUtils."
;; Get ourselves initialized.
- (call-next-method)
+ (cl-call-next-method)
;; Do the checks.
(require 'cedet-idutils)
(cedet-idutils-version-check)
(oref loc root)))
)
-(defmethod ede-locate-ok-in-project :static ((loc ede-locate-idutils)
+(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-idutils))
root)
"Is it ok to use this project type under ROOT."
(require 'cedet-idutils)
(when (cedet-idutils-support-for-directory root)
root))
-(defmethod ede-locate-file-in-project-impl ((loc ede-locate-idutils)
+(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-idutils)
filesubstring)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project
(let ((default-directory (oref loc root)))
(cedet-idutils-expand-filename filesubstring)))
-(defmethod ede-locate-create/update-root-database :STATIC
- ((loc ede-locate-idutils) root)
+(cl-defmethod ede-locate-create/update-root-database
+ ((loc (subclass ede-locate-idutils)) root)
"Create or update the GNU Global database for the current project."
(cedet-idutils-create/update-database root))
Configure EDE's use of Cscope through the cedet-cscope.el
file name searching variable `cedet-cscope-file-command'.")
-(defmethod initialize-instance ((loc ede-locate-cscope)
+(cl-defmethod initialize-instance ((loc ede-locate-cscope)
&rest slots)
"Make sure that we can use Cscope."
;; Get ourselves initialized.
- (call-next-method)
+ (cl-call-next-method)
;; Do the checks.
(require 'cedet-cscope)
(cedet-cscope-version-check)
(oref loc root)))
)
-(defmethod ede-locate-ok-in-project :static ((loc ede-locate-cscope)
+(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-cscope))
root)
"Is it ok to use this project type under ROOT."
(require 'cedet-cscope)
(when (cedet-cscope-support-for-directory root)
root))
-(defmethod ede-locate-file-in-project-impl ((loc ede-locate-cscope)
+(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-cscope)
filesubstring)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project
(require 'cedet-cscope)
(cedet-cscope-expand-filename filesubstring)))
-(defmethod ede-locate-create/update-root-database :STATIC
- ((loc ede-locate-cscope) root)
+(cl-defmethod ede-locate-create/update-root-database
+ ((loc (subclass ede-locate-cscope)) root)
"Create or update the GNU Global database for the current project."
(require 'cedet-cscope)
(cedet-cscope-create/update-database root))
don't do it. A value of nil means to just do it.")
;;; Code:
-(defmethod ede-proj-configure-file ((this ede-proj-project))
+(cl-defmethod ede-proj-configure-file ((this ede-proj-project))
"The configure.ac script used by project THIS."
(ede-expand-filename (ede-toplevel this) "configure.ac" t))
-(defmethod ede-proj-configure-test-required-file ((this ede-proj-project) file)
+(cl-defmethod ede-proj-configure-test-required-file ((this ede-proj-project) file)
"For project THIS, test that the file FILE exists, or create it."
(let ((f (ede-expand-filename (ede-toplevel this) file t)))
(when (not (file-exists-p f))
(error "Quit")))))))
-(defmethod ede-proj-configure-synchronize ((this ede-proj-project))
+(cl-defmethod ede-proj-configure-synchronize ((this ede-proj-project))
"Synchronize what we know about project THIS into configure.ac."
(let ((b (find-file-noselect (ede-proj-configure-file this)))
;;(td (file-name-directory (ede-proj-configure-file this)))
))))
-(defmethod ede-proj-configure-recreate ((this ede-proj-project))
+(cl-defmethod ede-proj-configure-recreate ((this ede-proj-project))
"Delete project THIS's configure script and start over."
(if (not (ede-proj-configure-file this))
(error "Could not determine configure.ac for %S" (eieio-object-name this)))
(if b (kill-buffer b)))
(ede-proj-configure-synchronize this))
-(defmethod ede-proj-tweak-autoconf ((this ede-proj-target))
+(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target))
"Tweak the configure file (current buffer) to accommodate THIS."
;; Check the compilers belonging to THIS, and call the autoconf
;; setup for those compilers.
(mapc 'ede-proj-tweak-autoconf (ede-proj-linkers this))
)
-(defmethod ede-proj-flush-autoconf ((this ede-proj-target))
+(cl-defmethod ede-proj-flush-autoconf ((this ede-proj-target))
"Flush the configure file (current buffer) to accommodate THIS.
By flushing, remove any cruft that may be in the file. Subsequent
calls to `ede-proj-tweak-autoconf' can restore items removed by flush."
;; @TODO - No-one calls this ???
-(defmethod ede-proj-configure-add-missing ((this ede-proj-target))
+(cl-defmethod ede-proj-configure-add-missing ((this ede-proj-target))
"Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake."
nil)
;; @TODO - No-one implements this yet.
-(defmethod ede-proj-configure-create-missing ((this ede-proj-target))
+(cl-defmethod ede-proj-configure-create-missing ((this ede-proj-target))
"Add any missing files for THIS by creating them."
nil)
(declare-function ede-srecode-insert "ede/srecode")
;;; Code:
-(defmethod ede-proj-makefile-create ((this ede-proj-project) mfilename)
+(cl-defmethod ede-proj-makefile-create ((this ede-proj-project) mfilename)
"Create a Makefile for all Makefile targets in THIS.
MFILENAME is the makefile to generate."
(require 'ede/srecode)
(setq name (replace-match "_" nil t name)))
name))
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target))
"Return the variable name for THIS's sources."
(concat (ede-pmake-varname this) "_YOU_FOUND_A_BUG"))
;;; DEPENDENCY FILE GENERATOR LISTS
;;
-(defmethod ede-proj-makefile-dependency-files ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-dependency-files ((this ede-proj-target))
"Return a list of source files to convert to dependencies.
Argument THIS is the target to get sources from."
nil)
;;; GENERIC VARIABLES
;;
-(defmethod ede-proj-makefile-configuration-variables ((this ede-proj-project)
+(cl-defmethod ede-proj-makefile-configuration-variables ((this ede-proj-project)
configuration)
"Return a list of configuration variables from THIS.
Use CONFIGURATION as the current configuration to query."
(cdr (assoc configuration (oref this configuration-variables))))
-(defmethod ede-proj-makefile-insert-variables-new ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-variables-new ((this ede-proj-project))
"Insert variables needed by target THIS.
NOTE: Not yet in use! This is part of an SRecode conversion of
; ))
)
-(defmethod ede-proj-makefile-insert-variables ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-project))
"Insert variables needed by target THIS."
(let ((conf-table (ede-proj-makefile-configuration-variables
this (oref this configuration-default)))
(insert "\nede_FILES=" (file-name-nondirectory (oref this file)) " "
(file-name-nondirectory (ede-proj-dist-makefile this)) "\n"))
-(defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target)
+(cl-defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target)
&optional
moresource)
"Insert the source variables needed by THIS.
(if moresource
(insert " \\\n " (mapconcat (lambda (a) a) moresource " ") "")))))
-(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target) &optional
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target) &optional
moresource)
"Insert variables needed by target THIS.
Optional argument MORESOURCE is a list of additional sources to add to the
(ede-proj-makefile-insert-source-variables this moresource)
)
-(defmethod ede-proj-makefile-configuration-variables ((this ede-proj-target-makefile)
+(cl-defmethod ede-proj-makefile-configuration-variables ((this ede-proj-target-makefile)
configuration)
"Return a list of configuration variables from THIS.
Use CONFIGURATION as the current configuration to query."
(cdr (assoc configuration (oref this configuration-variables))))
-(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile)
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile)
&optional moresource)
"Insert variables needed by target THIS.
Optional argument MORESOURCE is a list of additional sources to add to the
sources variable."
- (call-next-method)
+ (cl-call-next-method)
(let* ((proj (ede-target-parent this))
(conf-table (ede-proj-makefile-configuration-variables
this (oref proj configuration-default)))
(ede-linker-only-once linker
(ede-proj-makefile-insert-variables linker)))))
-(defmethod ede-proj-makefile-insert-automake-pre-variables
+(cl-defmethod ede-proj-makefile-insert-automake-pre-variables
((this ede-proj-target))
"Insert variables needed by target THIS in Makefile.am before SOURCES."
nil)
-(defmethod ede-proj-makefile-insert-automake-post-variables
+(cl-defmethod ede-proj-makefile-insert-automake-post-variables
((this ede-proj-target))
"Insert variables needed by target THIS in Makefile.am after SOURCES."
nil)
;;; GARBAGE PATTERNS
;;
-(defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-project))
"Return a list of patterns that are considered garbage to THIS.
These are removed with make clean."
(let ((mc (ede-map-targets
(setq mc (cdr mc)))
(nreverse uniq)))
-(defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-target))
"Return a list of patterns that are considered garbage to THIS.
These are removed with make clean."
;; Get the source object from THIS, and use the specified garbage.
;;; RULES
;;
-(defmethod ede-proj-makefile-insert-subproj-rules ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-subproj-rules ((this ede-proj-project))
"Insert a rule for the project THIS which should be a subproject."
(insert ".PHONY:" (ede-name this))
(newline)
(newline)
)
-(defmethod ede-proj-makefile-insert-rules ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-project))
"Insert rules needed by THIS target."
(mapc 'ede-proj-makefile-insert-rules (oref this inference-rules))
)
-(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-project))
"Insert any symbols that the DIST rule should depend on.
Argument THIS is the project that should insert stuff."
(mapc 'ede-proj-makefile-insert-dist-dependencies (oref this targets))
)
-(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target))
"Insert any symbols that the DIST rule should depend on.
Argument THIS is the target that should insert stuff."
nil)
-(defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target))
"Insert any symbols that the DIST rule should depend on.
Argument THIS is the target that should insert stuff."
(ede-proj-makefile-insert-dist-dependencies this)
)
-(defmethod ede-proj-makefile-automake-insert-subdirs ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-automake-insert-subdirs ((this ede-proj-project))
"Insert a SUBDIRS variable for Automake."
(proj-comp-insert-variable-once "SUBDIRS"
(ede-map-subprojects
(insert " " (ede-subproject-relative-path sproj))
))))
-(defmethod ede-proj-makefile-automake-insert-extradist ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-automake-insert-extradist ((this ede-proj-project))
"Insert the EXTRADIST variable entries needed for Automake and EDE."
(proj-comp-insert-variable-once "EXTRA_DIST" (insert "Project.ede")))
-(defmethod ede-proj-makefile-insert-dist-rules ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-dist-rules ((this ede-proj-project))
"Insert distribution rules for THIS in a Makefile, such as CLEAN and DIST."
(let ((junk (ede-proj-makefile-garbage-patterns this))
tmp)
"\t@false\n\n"
"\n\n# End of Makefile\n")))
-(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target))
"Insert rules needed by THIS target."
nil)
-(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile))
"Insert rules needed by THIS target."
(mapc 'ede-proj-makefile-insert-rules (oref this rules))
(let ((c (ede-proj-compilers this)))
(ede-proj-makefile-insert-commands this)
)))
-(defmethod ede-proj-makefile-insert-commands ((this ede-proj-target-makefile))
+(cl-defmethod ede-proj-makefile-insert-commands ((this ede-proj-target-makefile))
"Insert the commands needed by target THIS.
For targets, insert the commands needed by the chosen compiler."
(mapc 'ede-proj-makefile-insert-commands (ede-proj-compilers this))
(mapc 'ede-proj-makefile-insert-commands (ede-proj-linkers this))))
-(defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-project))
"Insert user specified rules needed by THIS target.
This is different from `ede-proj-makefile-insert-rules' in that this
function won't create the building rules which are auto created with
automake."
(mapc 'ede-proj-makefile-insert-user-rules (oref this inference-rules)))
-(defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-target))
"Insert user specified rules needed by THIS target."
(mapc 'ede-proj-makefile-insert-rules (oref this rules)))
-(defmethod ede-proj-makefile-dependencies ((this ede-proj-target-makefile))
+(cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-makefile))
"Return a string representing the dependencies for THIS.
Some compilers only use the first element in the dependencies, others
have a list of intermediates (object files), and others don't care.
out))))
;; Tags
-(defmethod ede-proj-makefile-tags ((this ede-proj-project) targets)
+(cl-defmethod ede-proj-makefile-tags ((this ede-proj-project) targets)
"Insert into the current location rules to make recursive TAGS files.
Argument THIS is the project to create tags for.
Argument TARGETS are the targets we should depend on for TAGS."
:objectextention "")
"Linker object for creating an archive.")
-(defmethod ede-proj-makefile-insert-source-variables :BEFORE
+(cl-defmethod ede-proj-makefile-insert-source-variables :before
((this ede-proj-target-makefile-archive) &optional moresource)
"Insert bin_PROGRAMS variables needed by target THIS.
We aren't actually inserting SOURCE details, but this is used by the
(concat "lib" (ede-name this) "_a_LIBRARIES")
(insert (concat "lib" (ede-name this) ".a"))))
-(defmethod ede-proj-makefile-garbage-patterns
+(cl-defmethod ede-proj-makefile-garbage-patterns
((this ede-proj-target-makefile-archive))
"Add archive name to the garbage patterns.
This makes sure that the archive is removed with 'make clean'."
- (let ((garb (call-next-method)))
+ (let ((garb (cl-call-next-method)))
(append garb (list (concat "lib" (ede-name this) ".a")))))
(provide 'ede/proj-archive)
:sourcepattern "^[A-Z]+$\\|\\.txt$")
"Miscellaneous fields definition.")
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-aux))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-aux))
"Return the variable name for THIS's sources."
(concat (ede-pmake-varname this) "_AUX"))
This is used when creating a Makefile to prevent duplicate variables and
rules from being created.")
-(defmethod initialize-instance :AFTER ((this ede-compiler) &rest fields)
+(cl-defmethod initialize-instance :after ((this ede-compiler) &rest fields)
"Make sure that all ede compiler objects are cached in
`ede-compiler-list'."
(add-to-list 'ede-compiler-list this))
-(defmethod initialize-instance :AFTER ((this ede-linker) &rest fields)
+(cl-defmethod initialize-instance :after ((this ede-linker) &rest fields)
"Make sure that all ede compiler objects are cached in
`ede-linker-list'."
(add-to-list 'ede-linker-list this))
(car-safe linkers))
;;; Methods:
-(defmethod ede-proj-tweak-autoconf ((this ede-compilation-program))
+(cl-defmethod ede-proj-tweak-autoconf ((this ede-compilation-program))
"Tweak the configure file (current buffer) to accommodate THIS."
(mapcar
(lambda (obj)
)
(oref this autoconf)))
-(defmethod ede-proj-flush-autoconf ((this ede-compilation-program))
+(cl-defmethod ede-proj-flush-autoconf ((this ede-compilation-program))
"Flush the configure file (current buffer) to accommodate THIS."
nil)
))
(put 'proj-comp-insert-variable-once 'lisp-indent-function 1)
-(defmethod ede-proj-makefile-insert-variables ((this ede-compilation-program))
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-compilation-program))
"Insert variables needed by the compiler THIS."
(if (eieio-instance-inheritor-slot-boundp this 'variables)
(with-slots (variables) this
(insert cd)))))
variables))))
-(defmethod ede-compiler-intermediate-objects-p ((this ede-compiler))
+(cl-defmethod ede-compiler-intermediate-objects-p ((this ede-compiler))
"Return non-nil if THIS has intermediate object files.
If this compiler creates code that can be linked together,
then the object files created by the compiler are considered intermediate."
(oref this uselinker))
-(defmethod ede-compiler-intermediate-object-variable ((this ede-compiler)
+(cl-defmethod ede-compiler-intermediate-object-variable ((this ede-compiler)
targetname)
"Return a string based on THIS representing a make object variable.
TARGETNAME is the name of the target that these objects belong to."
(concat targetname "_OBJ"))
-(defmethod ede-proj-makefile-insert-object-variables ((this ede-compiler)
+(cl-defmethod ede-proj-makefile-insert-object-variables ((this ede-compiler)
targetname sourcefiles)
"Insert an OBJ variable to specify object code to be generated for THIS.
The name of the target is TARGETNAME as a string. SOURCEFILES is the list of
sourcefiles)
(insert "\n")))))
-(defmethod ede-proj-makefile-insert-rules ((this ede-compilation-program))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-compilation-program))
"Insert rules needed for THIS compiler object."
(ede-compiler-only-once this
(mapc 'ede-proj-makefile-insert-rules (oref this rules))))
-(defmethod ede-proj-makefile-insert-rules ((this ede-makefile-rule))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-makefile-rule))
"Insert rules needed for THIS rule object."
(if (oref this phony) (insert ".PHONY: " (oref this target) "\n"))
(insert (oref this target) ": " (oref this dependencies) "\n\t"
(mapconcat (lambda (c) c) (oref this rules) "\n\t")
"\n\n"))
-(defmethod ede-proj-makefile-insert-commands ((this ede-compilation-program))
+(cl-defmethod ede-proj-makefile-insert-commands ((this ede-compilation-program))
"Insert the commands needed to use compiler THIS.
The object creating makefile rules must call this method for the
compiler it decides to use after inserting in the rule."
"This target consists of a group of lisp files.
A lisp target may be one general program with many separate lisp files in it.")
-(defmethod ede-proj-makefile-insert-rules :after ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-makefile-insert-rules :after ((this ede-proj-target-elisp))
"Insert rules needed by THIS target.
This inserts the PRELOADS target-local variable."
(let ((preloads (oref this pre-load-packages)))
(mapconcat 'identity preloads " ")))))
(insert "\n"))
-(defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp))
"Return a string representing the dependencies for THIS.
Some compilers only use the first element in the dependencies, others
have a list of intermediates (object files), and others don't care.
"Compile Emacs Lisp programs with XEmacs.")
;;; Claiming files
-(defmethod ede-buffer-mine ((this ede-proj-target-elisp) buffer)
+(cl-defmethod ede-buffer-mine ((this ede-proj-target-elisp) buffer)
"Return t if object THIS lays claim to the file in BUFFER.
Lays claim to all .elc files that match .el files in this target."
(if (string-match "\\.elc$" (buffer-file-name buffer))
;; Is this in our list.
(member fname (oref this auxsource))
)
- (call-next-method) ; The usual thing.
+ (cl-call-next-method) ; The usual thing.
))
;;; Emacs Lisp Compiler
packages (cdr packages))))
paths))
-(defmethod project-compile-target ((obj ede-proj-target-elisp))
+(cl-defmethod project-compile-target ((obj ede-proj-target-elisp))
"Compile all sources in a Lisp target OBJ.
Bonus: Return a cons cell: (COMPILED . UPTODATE)."
(let* ((proj (ede-target-parent obj))
(message "All Emacs Lisp sources are up to date in %s" (eieio-object-name obj))
(cons comp utd)))
-(defmethod ede-update-version-in-source ((this ede-proj-target-elisp) version)
+(cl-defmethod ede-update-version-in-source ((this ede-proj-target-elisp) version)
"In a Lisp file, updated a version string for THIS to VERSION.
There are standards in Elisp files specifying how the version string
is found, such as a `-version' variable, or the standard header."
(insert version)))))
(setq vs (cdr vs)))
;; The next method will include comments such as "Version:"
- (call-next-method))))
+ (cl-call-next-method))))
;;; Makefile generation functions
;;
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp))
"Return the variable name for THIS's sources."
(cond ((ede-proj-automake-p) '("lisp_LISP" . share))
(t (concat (ede-pmake-varname this) "_LISP"))))
(setq items (cdr items)))))
))
-(defmethod ede-proj-makefile-insert-variables :AFTER ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-makefile-insert-variables :after ((this ede-proj-target-elisp))
"Insert variables needed by target THIS."
(let ((newitems (if (oref this aux-packages)
(ede-proj-elisp-packages-to-loadpath
)
(error "Don't know how to update load path"))))
-(defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp))
"Tweak the configure file (current buffer) to accommodate THIS."
- (call-next-method)
+ (cl-call-next-method)
;; Ok, now we have to tweak the autoconf provided `elisp-comp' program.
(let ((ec (ede-expand-filename this "elisp-comp" 'newfile))
(enable-local-variables nil))
(save-buffer)
(kill-buffer)))))
-(defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp))
"Flush the configure file (current buffer) to accommodate THIS."
;; Remove crufty old paths from elisp-compile
(let ((ec (ede-expand-filename this "elisp-comp" 'newfile))
;;; Claiming files
-(defmethod ede-buffer-mine ((this ede-proj-target-elisp-autoloads) buffer)
+(cl-defmethod ede-buffer-mine ((this ede-proj-target-elisp-autoloads) buffer)
"Return t if object THIS lays claim to the file in BUFFER.
Lays claim to all .elc files that match .el files in this target."
(if (string-match
(concat (regexp-quote (oref this autoload-file)) "$")
(buffer-file-name buffer))
t
- (call-next-method) ; The usual thing.
+ (cl-call-next-method) ; The usual thing.
))
;; Compilers
)
"Build an autoloads file.")
-(defmethod ede-proj-compilers ((obj ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-compilers ((obj ede-proj-target-elisp-autoloads))
"List of compilers being used by OBJ.
If the `compiler' slot is empty, get the car of the compilers list."
(let ((comp (oref obj compiler)))
(setq comp (list (car avail)))))
comp))
-(defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target-elisp-autoloads)
+(cl-defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target-elisp-autoloads)
&optional
moresource)
"Insert the source variables needed by THIS.
sources variable."
nil)
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp-autoloads))
"Return the variable name for THIS's sources."
nil) ; "LOADDEFS")
-(defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp-autoloads))
"Return a string representing the dependencies for THIS.
Always return an empty string for an autoloads generator."
"")
-(defmethod ede-proj-makefile-insert-variables :AFTER ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-insert-variables :after ((this ede-proj-target-elisp-autoloads))
"Insert variables needed by target THIS."
(ede-pmake-insert-variable-shared "LOADDEFS"
(insert (oref this autoload-file)))
" ")))
)
-(defmethod project-compile-target ((obj ede-proj-target-elisp-autoloads))
+(cl-defmethod project-compile-target ((obj ede-proj-target-elisp-autoloads))
"Create or update the autoload target."
(require 'cedet-autogen)
(let ((default-directory (ede-expand-filename obj ".")))
(oref obj autoload-dirs))
))
-(defmethod ede-update-version-in-source ((this ede-proj-target-elisp-autoloads) version)
+(cl-defmethod ede-update-version-in-source ((this ede-proj-target-elisp-autoloads) version)
"In a Lisp file, updated a version string for THIS to VERSION.
There are standards in Elisp files specifying how the version string
is found, such as a `-version' variable, or the standard header."
nil)
-(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-elisp-autoloads))
"Insert any symbols that the DIST rule should depend on.
Emacs Lisp autoload files ship the generated .el files.
Argument THIS is the target which needs to insert an info file."
(insert " " (ede-proj-makefile-target-name this))
)
-(defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-elisp-autoloads))
"Insert any symbols that the DIST rule should distribute.
Emacs Lisp autoload files ship the generated .el files.
Argument THIS is the target which needs to insert an info file."
(insert " " (oref this autoload-file))
)
-(defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp-autoloads))
"Tweak the configure file (current buffer) to accommodate THIS."
(error "Autoloads not supported in autoconf yet"))
-(defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp-autoloads))
"Flush the configure file (current buffer) to accommodate THIS."
nil)
;;; Makefile generation
;;
-(defmethod ede-proj-configure-add-missing
+(cl-defmethod ede-proj-configure-add-missing
((this ede-proj-target-makefile-info))
"Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake."
(not (ede-expand-filename (ede-toplevel) "texinfo.tex")))
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-info))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-info))
"Return the variable name for THIS's sources."
(concat (ede-pmake-varname this) "_TEXINFOS"))
-(defmethod ede-proj-makefile-insert-source-variables
+(cl-defmethod ede-proj-makefile-insert-source-variables
((this ede-proj-target-makefile-info) &optional moresource)
"Insert the source variables needed by THIS info target.
Optional argument MORESOURCE is a list of additional sources to add to the
Does the usual for Makefile mode, but splits source into two variables
when working in Automake mode."
(if (not (ede-proj-automake-p))
- (call-next-method)
+ (cl-call-next-method)
(let* ((sv (ede-proj-makefile-sourcevar this))
(src (copy-sequence (oref this source)))
(menu (or (oref this menu) (car src))))
(kill-buffer buffer))
info))
-(defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-info))
+(cl-defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-info))
"Return the name of the main target for THIS target."
;; The target should be the main-menu file name translated to .info.
(let* ((source (if (not (string= (oref this mainmenu) ""))
(info (ede-makeinfo-find-info-filename source)))
(concat (or info (file-name-sans-extension source)) ".info")))
-(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-makefile-info))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-makefile-info))
"Insert any symbols that the DIST rule should depend on.
Texinfo files want to insert generated `.info' files.
Argument THIS is the target which needs to insert an info file."
(insert " " (ede-proj-makefile-target-name this))
)
-(defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-makefile-info))
+(cl-defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-makefile-info))
"Insert any symbols that the DIST rule should depend on.
Texinfo files want to insert generated `.info' files.
Argument THIS is the target which needs to insert an info file."
; n
; (concat n ".info"))))
-(defmethod object-write ((this ede-proj-target-makefile-info))
+(cl-defmethod object-write ((this ede-proj-target-makefile-info))
"Before committing any change to THIS, make sure the mainmenu is first."
(let ((mm (oref this mainmenu))
(s (oref this source))
;; Make sure that MM is first in the list of items.
(setq nl (cons mm (delq mm s)))
(oset this source nl)))
- (call-next-method))
+ (cl-call-next-method))
-(defmethod ede-documentation ((this ede-proj-target-makefile-info))
+(cl-defmethod ede-documentation ((this ede-proj-target-makefile-info))
"Return a list of files that provides documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
)
"Compile code via a sub-makefile.")
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-miscelaneous))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-miscelaneous))
"Return the variable name for THIS's sources."
(concat (ede-pmake-varname this) "_MISC"))
-(defmethod ede-proj-makefile-dependency-files
+(cl-defmethod ede-proj-makefile-dependency-files
((this ede-proj-target-makefile-miscelaneous))
"Return a list of files which THIS target depends on."
(with-slots (submakefile) this
nil)
(t (list submakefile)))))
-(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile-miscelaneous))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile-miscelaneous))
"Create the make rule needed to create an archive for THIS."
;; DO NOT call the next method. We will never have any compilers,
;; or any dependencies, or stuff like this. This rule will let us
;;; The EDE object compiler
;;
-(defmethod ede-proj-makefile-insert-variables ((this ede-object-compiler))
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-object-compiler))
"Insert variables needed by the compiler THIS."
- (call-next-method)
+ (cl-call-next-method)
(if (eieio-instance-inheritor-slot-boundp this 'dependencyvar)
(with-slots (dependencyvar) this
(insert (car dependencyvar) "=")
;;; EDE Object target type methods
;;
-(defmethod ede-proj-makefile-sourcevar
+(cl-defmethod ede-proj-makefile-sourcevar
((this ede-proj-target-makefile-objectcode))
"Return the variable name for THIS's sources."
(require 'ede/pmake)
(concat (ede-pmake-varname this) "_SOURCES"))
-(defmethod ede-proj-makefile-dependency-files
+(cl-defmethod ede-proj-makefile-dependency-files
((this ede-proj-target-makefile-objectcode))
"Return a list of source files to convert to dependencies.
Argument THIS is the target to get sources from."
(append (oref this source) (oref this auxsource)))
-(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-objectcode)
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-objectcode)
&optional moresource)
"Insert variables needed by target THIS.
Optional argument MORESOURCE is not used."
(let ((ede-proj-objectcode-dodependencies
(oref (ede-target-parent this) automatic-dependencies)))
- (call-next-method)))
+ (cl-call-next-method)))
-(defmethod ede-buffer-header-file((this ede-proj-target-makefile-objectcode)
+(cl-defmethod ede-buffer-header-file((this ede-proj-target-makefile-objectcode)
buffer)
"There are no default header files."
- (or (call-next-method)
+ (or (cl-call-next-method)
;; Ok, nothing obvious. Try looking in ourselves.
(let ((h (oref this auxsource)))
;; Add more logic here when the problem is better understood.
)
"This target is an executable program.")
-(defmethod ede-proj-makefile-insert-automake-pre-variables
+(cl-defmethod ede-proj-makefile-insert-automake-pre-variables
((this ede-proj-target-makefile-program))
"Insert bin_PROGRAMS variables needed by target THIS."
(ede-pmake-insert-variable-shared "bin_PROGRAMS"
(insert (ede-name this)))
- (call-next-method))
+ (cl-call-next-method))
-(defmethod ede-proj-makefile-insert-automake-post-variables
+(cl-defmethod ede-proj-makefile-insert-automake-post-variables
((this ede-proj-target-makefile-program))
"Insert bin_PROGRAMS variables needed by target THIS."
(ede-pmake-insert-variable-shared
(when (oref this ldlibs)
(mapc (lambda (d) (insert " -l" d)) (oref this ldlibs)))
)
- (call-next-method))
+ (cl-call-next-method))
-(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-program))
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-program))
"Insert variables needed by the compiler THIS."
- (call-next-method)
+ (cl-call-next-method)
(let ((lf (mapconcat 'identity (oref this ldflags) " ")))
(with-slots (ldlibs) this
(if ldlibs
(when (and lf (not (string= "" lf)))
(ede-pmake-insert-variable-once "LDDEPS" (insert lf)))))
-(defmethod project-debug-target ((obj ede-proj-target-makefile-program))
+(cl-defmethod project-debug-target ((obj ede-proj-target-makefile-program))
"Debug a program target OBJ."
(let ((tb (get-buffer-create " *padt*"))
(dd (if (not (string= (oref obj path) ""))
(funcall ede-debug-program-function cmd))
(kill-buffer tb))))
-(defmethod project-run-target ((obj ede-proj-target-makefile-program) &optional command)
+(cl-defmethod project-run-target ((obj ede-proj-target-makefile-program) &optional command)
"Run a program target OBJ.
Optional COMMAND is the command to run in place of asking the user."
(require 'ede/shell)
)
"This target consists of scheme files.")
-(defmethod ede-proj-tweak-autoconf ((this ede-proj-target-scheme))
+(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-scheme))
"Tweak the configure file (current buffer) to accommodate THIS."
(autoconf-insert-new-macro "AM_INIT_GUILE_MODULE"))
"\t@-rm -f .deps/$(*F).p\n\n"))
)
-(defmethod ede-proj-configure-add-missing
+(cl-defmethod ede-proj-configure-add-missing
((this ede-proj-target-makefile-shared-object))
"Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake."
(not (and (ede-expand-filename (ede-toplevel) "ltconfig")
(ede-expand-filename (ede-toplevel) "ltmain.sh"))))
-(defmethod ede-proj-makefile-insert-automake-pre-variables
+(cl-defmethod ede-proj-makefile-insert-automake-pre-variables
((this ede-proj-target-makefile-shared-object))
"Insert bin_PROGRAMS variables needed by target THIS.
We aren't actually inserting SOURCE details, but this is used by the
(ede-pmake-insert-variable-shared "lib_LTLIBRARIES"
(insert (concat "lib" (ede-name this) ".la"))))
-(defmethod ede-proj-makefile-insert-automake-post-variables
+(cl-defmethod ede-proj-makefile-insert-automake-post-variables
((this ede-proj-target-makefile-shared-object))
"Insert bin_PROGRAMS variables needed by target THIS.
We need to override -program which has an LDADD element."
nil)
-(defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-shared-object))
+(cl-defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-shared-object))
"Return the name of the main target for THIS target."
;; We need some platform gunk to make the .so change to .sl, or .a,
;; depending on the platform we are going to compile against.
(concat "lib" (ede-name this) ".la"))
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-shared-object))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-shared-object))
"Return the variable name for THIS's sources."
(if (eq (oref (ede-target-parent this) makefile-type) 'Makefile.am)
(concat "lib" (oref this name) "_la_SOURCES")
- (call-next-method)))
+ (cl-call-next-method)))
(provide 'ede/proj-shared)
;; Restore the directory slot
(oset project directory cdir))) ))
-(defmethod ede-commit-local-variables ((proj ede-proj-project))
+(cl-defmethod ede-commit-local-variables ((proj ede-proj-project))
"Commit change to local variables in PROJ."
(ede-proj-save proj))
-(defmethod eieio-done-customizing ((proj ede-proj-project))
+(cl-defmethod eieio-done-customizing ((proj ede-proj-project))
"Call this when a user finishes customizing this object.
Argument PROJ is the project to save."
- (call-next-method)
+ (cl-call-next-method)
(ede-proj-save proj))
-(defmethod eieio-done-customizing ((target ede-proj-target))
+(cl-defmethod eieio-done-customizing ((target ede-proj-target))
"Call this when a user finishes customizing this object.
Argument TARGET is the project we are completing customization on."
- (call-next-method)
+ (cl-call-next-method)
(ede-proj-save (ede-current-project)))
-(defmethod ede-commit-project ((proj ede-proj-project))
+(cl-defmethod ede-commit-project ((proj ede-proj-project))
"Commit any change to PROJ to its file."
(ede-proj-save proj))
-(defmethod ede-buffer-mine ((this ede-proj-project) buffer)
+(cl-defmethod ede-buffer-mine ((this ede-proj-project) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(let ((f (ede-convert-path this (buffer-file-name buffer))))
(or (string= (file-name-nondirectory (oref this file)) f)
(member f '("AUTHORS" "NEWS" "COPYING" "INSTALL" "README"))
)))
-(defmethod ede-buffer-mine ((this ede-proj-target) buffer)
+(cl-defmethod ede-buffer-mine ((this ede-proj-target) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
- (or (call-next-method)
+ (or (cl-call-next-method)
(ede-target-buffer-in-sourcelist this buffer (oref this auxsource))))
\f
(defvar ede-proj-target-history nil
"History when querying for a target type.")
-(defmethod project-new-target ((this ede-proj-project)
+(cl-defmethod project-new-target ((this ede-proj-project)
&optional name type autoadd)
"Create a new target in THIS based on the current buffer."
(let* ((name (or name (read-string "Name: " "")))
;; And save
(ede-proj-save this)))
-(defmethod project-new-target-custom ((this ede-proj-project))
+(cl-defmethod project-new-target-custom ((this ede-proj-project))
"Create a new target in THIS for custom."
(let* ((name (read-string "Name: " ""))
(type (completing-read "Type: " ede-proj-target-alist
:path (ede-convert-path this default-directory)
:source nil)))
-(defmethod project-delete-target ((this ede-proj-target))
+(cl-defmethod project-delete-target ((this ede-proj-target))
"Delete the current target THIS from its parent project."
(let ((p (ede-current-project))
(ts (oref this source)))
(oset p targets (delq this (oref p targets)))
(ede-proj-save (ede-current-project))))
-(defmethod project-add-file ((this ede-proj-target) file)
+(cl-defmethod project-add-file ((this ede-proj-target) file)
"Add to target THIS the current buffer represented as FILE."
(let ((file (ede-convert-path this file))
(src (ede-target-sourcecode this)))
(t (error "`project-add-file(ede-target)' source mismatch error")))
(ede-proj-save))))
-(defmethod project-remove-file ((target ede-proj-target) file)
+(cl-defmethod project-remove-file ((target ede-proj-target) file)
"For TARGET, remove FILE.
FILE must be massaged by `ede-convert-path'."
;; Speedy delete should be safe.
(object-remove-from-list target 'auxsource (ede-convert-path target file))
(ede-proj-save))
-(defmethod project-update-version ((this ede-proj-project))
+(cl-defmethod project-update-version ((this ede-proj-project))
"The :version of project THIS has changed."
(ede-proj-save))
-(defmethod project-make-dist ((this ede-proj-project))
+(cl-defmethod project-make-dist ((this ede-proj-project))
"Build a distribution for the project based on THIS target."
(let ((pm (ede-proj-dist-makefile this))
(df (project-dist-files this)))
(file-name-directory pm))))
(compile (concat ede-make-command " -f " pm " dist"))))
-(defmethod project-dist-files ((this ede-proj-project))
+(cl-defmethod project-dist-files ((this ede-proj-project))
"Return a list of files that constitutes a distribution of THIS project."
(list
;; Note to self, keep this first for the above fn to check against.
(concat (oref this name) "-" (oref this version) ".tar.gz")
))
-(defmethod project-compile-project ((proj ede-proj-project) &optional command)
+(cl-defmethod project-compile-project ((proj ede-proj-project) &optional command)
"Compile the entire current project PROJ.
Argument COMMAND is the command to use when compiling."
(let ((pm (ede-proj-dist-makefile proj))
;;; Target type specific compilations/debug
;;
-(defmethod project-compile-target ((obj ede-proj-target) &optional command)
+(cl-defmethod project-compile-target ((obj ede-proj-target) &optional command)
"Compile the current target OBJ.
Argument COMMAND is the command to use for compiling the target."
(project-compile-project (ede-current-project) command))
-(defmethod project-compile-target ((obj ede-proj-target-makefile)
+(cl-defmethod project-compile-target ((obj ede-proj-target-makefile)
&optional command)
"Compile the current target program OBJ.
Optional argument COMMAND is the s the alternate command to use."
(compile (concat ede-make-command " -f " (oref obj makefile) " "
(ede-proj-makefile-target-name obj))))
-(defmethod project-debug-target ((obj ede-proj-target))
+(cl-defmethod project-debug-target ((obj ede-proj-target))
"Run the current project target OBJ in a debugger."
(error "Debug-target not supported by %s" (eieio-object-name obj)))
-(defmethod project-run-target ((obj ede-proj-target))
+(cl-defmethod project-run-target ((obj ede-proj-target))
"Run the current project target OBJ."
(error "Run-target not supported by %s" (eieio-object-name obj)))
-(defmethod ede-proj-makefile-target-name ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-target-name ((this ede-proj-target))
"Return the name of the main target for THIS target."
(ede-name this))
\f
;;; Compiler and source code generators
;;
-(defmethod ede-want-file-auxiliary-p ((this ede-target) file)
+(cl-defmethod ede-want-file-auxiliary-p ((this ede-target) file)
"Return non-nil if THIS target wants FILE."
;; By default, all targets reference the source object, and let it decide.
(let ((src (ede-target-sourcecode this)))
(setq src (cdr src)))
src))
-(defmethod ede-proj-compilers ((obj ede-proj-target))
+(cl-defmethod ede-proj-compilers ((obj ede-proj-target))
"List of compilers being used by OBJ.
If the `compiler' slot is empty, concoct one on a first match found
basis for any given type from the `availablecompilers' slot.
;; Return the discovered compilers.
comp)))
-(defmethod ede-proj-linkers ((obj ede-proj-target))
+(cl-defmethod ede-proj-linkers ((obj ede-proj-target))
"List of linkers being used by OBJ.
If the `linker' slot is empty, concoct one on a first match found
basis for any given type from the `availablelinkers' slot.
"Return non-nil if the current project PROJ is automake mode."
(eq (ede-proj-makefile-type proj) 'Makefile))
-(defmethod ede-proj-dist-makefile ((this ede-proj-project))
+(cl-defmethod ede-proj-dist-makefile ((this ede-proj-project))
"Return the name of the Makefile with the DIST target in it for THIS."
(cond ((eq (oref this makefile-type) 'Makefile.am)
(concat (file-name-directory (oref this file))
(interactive)
(ede-proj-setup-buildenvironment (ede-current-project) t))
-(defmethod ede-proj-makefile-create-maybe ((this ede-proj-project) mfilename)
+(cl-defmethod ede-proj-makefile-create-maybe ((this ede-proj-project) mfilename)
"Create a Makefile for all Makefile targets in THIS if needed.
MFILENAME is the makefile to generate."
;; For now, pass through until dirty is implemented.
(file-newer-than-file-p (oref this file) mfilename))
(ede-proj-makefile-create this mfilename)))
-(defmethod ede-proj-setup-buildenvironment ((this ede-proj-project)
+(cl-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.ac combination.
\f
;;; Lower level overloads
;;
-(defmethod project-rescan ((this ede-proj-project))
+(cl-defmethod project-rescan ((this ede-proj-project))
"Rescan the EDE proj project THIS."
(let ((root (or (ede-project-root this) this))
)
"Encode one makefile.")
;;; Code:
-(defmethod project-add-file ((ot project-am-target))
+(cl-defmethod project-add-file ((ot project-am-target))
"Add the current buffer into a project.
OT is the object target. DIR is the directory to start in."
(let* ((target (if ede-object (error "Already associated w/ a target")
(save-buffer))
(setq ede-object ot)))
-(defmethod project-remove-file ((ot project-am-target) fnnd)
+(cl-defmethod project-remove-file ((ot project-am-target) fnnd)
"Remove the current buffer from any project targets."
(ede-with-projectfile ot
(makefile-move-to-macro (project-am-macro ot))
(save-buffer))
(setq ede-object nil))
-(defmethod project-edit-file-target ((obj project-am-target))
+(cl-defmethod project-edit-file-target ((obj project-am-target))
"Edit the target associated w/ this file."
(find-file (concat (oref obj path) "Makefile.am"))
(goto-char (point-min))
(if (= (point-min) (point))
(re-search-forward (ede-target-name obj))))
-(defmethod project-new-target ((proj project-am-makefile)
+(cl-defmethod project-new-target ((proj project-am-makefile)
&optional name type)
"Create a new target named NAME.
Argument TYPE is the type of target to insert. This is a string
;; This should be handled at the EDE level, calling a method of the
;; top most project.
;;
-(defmethod project-compile-project ((obj project-am-target) &optional command)
+(cl-defmethod project-compile-project ((obj project-am-target) &optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
(require 'compile)
(let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command)))
-(defmethod project-compile-project ((obj project-am-makefile)
+(cl-defmethod project-compile-project ((obj project-am-makefile)
&optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
(let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command)))
-(defmethod project-compile-target ((obj project-am-target) &optional command)
+(cl-defmethod project-compile-target ((obj project-am-target) &optional command)
"Compile the current target.
Argument COMMAND is the command to use for compiling the target."
(require 'compile)
;; We better be in the right place when compiling a specific target.
(compile command))
-(defmethod project-debug-target ((obj project-am-objectcode))
+(cl-defmethod project-debug-target ((obj project-am-objectcode))
"Run the current project target in a debugger."
(let ((tb (get-buffer-create " *padt*"))
(dd (oref obj path))
(declare-function ede-shell-run-something "ede/shell")
-(defmethod project-run-target ((obj project-am-objectcode))
+(cl-defmethod project-run-target ((obj project-am-objectcode))
"Run the current project target in comint buffer."
(require 'ede/shell)
(let ((tb (get-buffer-create " *padt*"))
(ede-shell-run-something obj cmd))
(kill-buffer tb))))
-(defmethod project-make-dist ((this project-am-target))
+(cl-defmethod project-make-dist ((this project-am-target))
"Run the current project in the debugger."
(require 'compile)
(if (not project-am-compile-project-command)
ampf))))
;;; Methods:
-(defmethod project-targets-for-file ((proj project-am-makefile))
+(cl-defmethod project-targets-for-file ((proj project-am-makefile))
"Return a list of targets the project PROJ."
(oref proj targets))
subdirs)
)
-(defmethod project-rescan ((this project-am-makefile) &optional suggestedname)
+(cl-defmethod project-rescan ((this project-am-makefile) &optional suggestedname)
"Rescan the makefile for all targets and sub targets."
(project-am-with-makefile-current (file-name-directory (oref this file))
;;(message "Scanning %s..." (oref this file))
)))
-(defmethod project-rescan ((this project-am-program))
+(cl-defmethod project-rescan ((this project-am-program))
"Rescan object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this)))
(unless (oref this :source)
(oset this :ldadd (makefile-macro-file-list
(concat (oref this :name) "_LDADD"))))
-(defmethod project-rescan ((this project-am-lib))
+(cl-defmethod project-rescan ((this project-am-lib))
"Rescan object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this)))
(unless (oref this :source)
(oset this :source (list (concat (file-name-sans-extension (oref this :name)) ".c")))))
-(defmethod project-rescan ((this project-am-texinfo))
+(cl-defmethod project-rescan ((this project-am-texinfo))
"Rescan object THIS."
(oset this :include (makefile-macro-file-list (project-am-macro this))))
-(defmethod project-rescan ((this project-am-man))
+(cl-defmethod project-rescan ((this project-am-man))
"Rescan object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this))))
-(defmethod project-rescan ((this project-am-lisp))
+(cl-defmethod project-rescan ((this project-am-lisp))
"Rescan the lisp sources."
(oset this :source (makefile-macro-file-list (project-am-macro this))))
-(defmethod project-rescan ((this project-am-header))
+(cl-defmethod project-rescan ((this project-am-header))
"Rescan the Header sources for object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this))))
-(defmethod project-rescan ((this project-am-built-src))
+(cl-defmethod project-rescan ((this project-am-built-src))
"Rescan built sources for object THIS."
(oset this :source (makefile-macro-file-list "BUILT_SOURCES")))
-(defmethod project-rescan ((this project-am-extra-dist))
+(cl-defmethod project-rescan ((this project-am-extra-dist))
"Rescan object THIS."
(oset this :source (makefile-macro-file-list "EXTRA_DIST")))
-(defmethod project-am-macro ((this project-am-objectcode))
+(cl-defmethod project-am-macro ((this project-am-objectcode))
"Return the default macro to 'edit' for this object type."
(concat (subst-char-in-string ?- ?_ (oref this :name)) "_SOURCES"))
-(defmethod project-am-macro ((this project-am-header-noinst))
+(cl-defmethod project-am-macro ((this project-am-header-noinst))
"Return the default macro to 'edit' for this object."
"noinst_HEADERS")
-(defmethod project-am-macro ((this project-am-header-inst))
+(cl-defmethod project-am-macro ((this project-am-header-inst))
"Return the default macro to 'edit' for this object."
"include_HEADERS")
-(defmethod project-am-macro ((this project-am-header-pkg))
+(cl-defmethod project-am-macro ((this project-am-header-pkg))
"Return the default macro to 'edit' for this object."
"pkginclude_HEADERS")
-(defmethod project-am-macro ((this project-am-header-chk))
+(cl-defmethod project-am-macro ((this project-am-header-chk))
"Return the default macro to 'edit' for this object."
"check_HEADERS")
-(defmethod project-am-macro ((this project-am-texinfo))
+(cl-defmethod project-am-macro ((this project-am-texinfo))
"Return the default macro to 'edit' for this object type."
(concat (file-name-sans-extension (oref this :name)) "_TEXINFOS"))
-(defmethod project-am-macro ((this project-am-man))
+(cl-defmethod project-am-macro ((this project-am-man))
"Return the default macro to 'edit' for this object type."
(oref this :name))
-(defmethod project-am-macro ((this project-am-lisp))
+(cl-defmethod project-am-macro ((this project-am-lisp))
"Return the default macro to 'edit' for this object."
"lisp_LISP")
sobj (cdr sobj)))
obj))))
-(defmethod ede-buffer-mine ((this project-am-makefile) buffer)
+(cl-defmethod ede-buffer-mine ((this project-am-makefile) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(let ((efn (expand-file-name (buffer-file-name buffer))))
(or (string= (oref this :file) efn)
ans)
)))
-(defmethod ede-buffer-mine ((this project-am-objectcode) buffer)
+(cl-defmethod ede-buffer-mine ((this project-am-objectcode) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(member (file-relative-name (buffer-file-name buffer) (oref this :path))
(oref this :source)))
-(defmethod ede-buffer-mine ((this project-am-texinfo) buffer)
+(cl-defmethod ede-buffer-mine ((this project-am-texinfo) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(let ((bfn (file-relative-name (buffer-file-name buffer)
(oref this :path))))
(or (string= (oref this :name) bfn)
(member bfn (oref this :include)))))
-(defmethod ede-buffer-mine ((this project-am-man) buffer)
+(cl-defmethod ede-buffer-mine ((this project-am-man) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(string= (oref this :name)
(file-relative-name (buffer-file-name buffer) (oref this :path))))
-(defmethod ede-buffer-mine ((this project-am-lisp) buffer)
+(cl-defmethod ede-buffer-mine ((this project-am-lisp) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(member (file-relative-name (buffer-file-name buffer) (oref this :path))
(oref this :source)))
-(defmethod project-am-subtree ((ampf project-am-makefile) subdir)
+(cl-defmethod project-am-subtree ((ampf project-am-makefile) subdir)
"Return the sub project in AMPF specified by SUBDIR."
(object-assoc (expand-file-name subdir) 'file (oref ampf subproj)))
-(defmethod project-compile-target-command ((this project-am-target))
+(cl-defmethod project-compile-target-command ((this project-am-target))
"Default target to use when compiling a given target."
;; This is a pretty good default for most.
"")
-(defmethod project-compile-target-command ((this project-am-objectcode))
+(cl-defmethod project-compile-target-command ((this project-am-objectcode))
"Default target to use when compiling an object code target."
(oref this :name))
-(defmethod project-compile-target-command ((this project-am-texinfo))
+(cl-defmethod project-compile-target-command ((this project-am-texinfo))
"Default target t- use when compiling a texinfo file."
(let ((n (oref this :name)))
(if (string-match "\\.texi?\\(nfo\\)?" n)
(t
'project-am-program)))
-(defmethod ede-buffer-header-file((this project-am-objectcode) buffer)
+(cl-defmethod ede-buffer-header-file((this project-am-objectcode) buffer)
"There are no default header files."
- (or (call-next-method)
+ (or (cl-call-next-method)
(let ((s (oref this source))
(found nil))
(while (and s (not found))
(setq s (cdr s)))
found)))
-(defmethod ede-documentation ((this project-am-texinfo))
+(cl-defmethod ede-documentation ((this project-am-texinfo))
"Return a list of files that provides documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
(project-am-extract-package-info dir)))
;; for simple per project include path extension
-(defmethod ede-system-include-path ((this project-am-makefile))
+(cl-defmethod ede-system-include-path ((this project-am-makefile))
"Return `project-am-localvars-include-path', usually local variable
per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path))
-(defmethod ede-system-include-path ((this project-am-target))
+(cl-defmethod ede-system-include-path ((this project-am-target))
"Return `project-am-localvars-include-path', usually local variable
per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path))
(declare-function comint-send-input "comint")
-(defmethod ede-shell-run-something ((target ede-target) command)
+(cl-defmethod ede-shell-run-something ((target ede-target) command)
"Create a shell to run stuff for TARGET.
COMMAND is a text string representing the thing to be run."
(let* ((buff (ede-shell-buffer target))
(comint-send-input)
)
-(defmethod ede-shell-buffer ((target ede-target))
+(cl-defmethod ede-shell-buffer ((target ede-target))
"Get the buffer for running shell commands for TARGET."
(let ((name (ede-name target)))
(get-buffer-create (format "*EDE Shell %s*" name))))
"EDE Simple project class.
Each directory needs a project file to control it.")
-(defmethod ede-commit-project ((proj ede-simple-project))
+(cl-defmethod ede-commit-project ((proj ede-simple-project))
"Commit any change to PROJ to its file."
(when (not (file-exists-p ede-simple-save-directory))
(if (y-or-n-p (concat ede-simple-save-directory
(error "No save directory for new project")))
(eieio-persistent-save proj))
-(defmethod ede-find-subproject-for-directory ((proj ede-simple-project)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-simple-project)
dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
;;; Methods
;;
-(defmethod initialize-instance :AFTER ((this ede-sourcecode) &rest fields)
+(cl-defmethod initialize-instance :after ((this ede-sourcecode) &rest fields)
"Make sure that all ede compiler objects are cached in
`ede-compiler-list'."
(let ((lst ede-sourcecode-list))
;; Add to the beginning of the list.
(setq ede-sourcecode-list (cons this ede-sourcecode-list)))))
-(defmethod ede-want-file-p ((this ede-sourcecode) filename)
+(cl-defmethod ede-want-file-p ((this ede-sourcecode) filename)
"Return non-nil if sourcecode definition THIS will take FILENAME."
(or (ede-want-file-source-p this filename)
(ede-want-file-auxiliary-p this filename)))
-(defmethod ede-want-file-source-p ((this ede-sourcecode) filename)
+(cl-defmethod ede-want-file-source-p ((this ede-sourcecode) filename)
"Return non-nil if THIS will take FILENAME as an auxiliary ."
(let ((case-fold-search nil))
(string-match (oref this sourcepattern) filename)))
-(defmethod ede-want-file-auxiliary-p ((this ede-sourcecode) filename)
+(cl-defmethod ede-want-file-auxiliary-p ((this ede-sourcecode) filename)
"Return non-nil if THIS will take FILENAME as an auxiliary ."
(let ((case-fold-search nil))
(and (slot-boundp this 'auxsourcepattern)
(oref this auxsourcepattern)
(string-match (oref this auxsourcepattern) filename))))
-(defmethod ede-want-any-source-files-p ((this ede-sourcecode) filenames)
+(cl-defmethod ede-want-any-source-files-p ((this ede-sourcecode) filenames)
"Return non-nil if THIS will accept any source files in FILENAMES."
(let (found)
(while (and (not found) filenames)
(setq found (ede-want-file-source-p this (pop filenames))))
found))
-(defmethod ede-want-any-auxiliary-files-p ((this ede-sourcecode) filenames)
+(cl-defmethod ede-want-any-auxiliary-files-p ((this ede-sourcecode) filenames)
"Return non-nil if THIS will accept any aux files in FILENAMES."
(let (found)
(while (and (not found) filenames)
(setq found (ede-want-file-auxiliary-p this (pop filenames))))
found))
-(defmethod ede-want-any-files-p ((this ede-sourcecode) filenames)
+(cl-defmethod ede-want-any-files-p ((this ede-sourcecode) filenames)
"Return non-nil if THIS will accept any files in FILENAMES."
(let (found)
(while (and (not found) filenames)
(setq found (ede-want-file-p this (pop filenames))))
found))
-(defmethod ede-buffer-header-file ((this ede-sourcecode) filename)
+(cl-defmethod ede-buffer-header-file ((this ede-sourcecode) filename)
"Return a list of file names of header files for THIS with FILENAME.
Used to guess header files, but uses the auxsource regular expression."
(let ((dn (file-name-directory filename))
(setq depth (1- depth)))
(speedbar-line-token))))
-(defmethod eieio-speedbar-derive-line-path ((obj ede-project) &optional depth)
+(cl-defmethod eieio-speedbar-derive-line-path ((obj ede-project) &optional depth)
"Return the path to OBJ.
Optional DEPTH is the depth we start at."
(file-name-directory (oref obj file))
)
-(defmethod eieio-speedbar-derive-line-path ((obj ede-target) &optional depth)
+(cl-defmethod eieio-speedbar-derive-line-path ((obj ede-target) &optional depth)
"Return the path to OBJ.
Optional DEPTH is the depth we start at."
(let ((proj (ede-target-parent obj)))
(concat (eieio-speedbar-derive-line-path proj)
(ede-find-nearest-file-line)))))))
-(defmethod eieio-speedbar-description ((obj ede-project))
+(cl-defmethod eieio-speedbar-description ((obj ede-project))
"Provide a speedbar description for OBJ."
(ede-description obj))
-(defmethod eieio-speedbar-description ((obj ede-target))
+(cl-defmethod eieio-speedbar-description ((obj ede-target))
"Provide a speedbar description for OBJ."
(ede-description obj))
-(defmethod eieio-speedbar-child-description ((obj ede-target))
+(cl-defmethod eieio-speedbar-child-description ((obj ede-target))
"Provide a speedbar description for a plain-child of OBJ.
A plain child is a child element which is not an EIEIO object."
(or (speedbar-item-info-file-helper)
(speedbar-item-info-tag-helper)))
-(defmethod eieio-speedbar-object-buttonname ((object ede-project))
+(cl-defmethod eieio-speedbar-object-buttonname ((object ede-project))
"Return a string to use as a speedbar button for OBJECT."
(if (ede-parent-project object)
(ede-name object)
(concat (ede-name object) " " (oref object version))))
-(defmethod eieio-speedbar-object-buttonname ((object ede-target))
+(cl-defmethod eieio-speedbar-object-buttonname ((object ede-target))
"Return a string to use as a speedbar button for OBJECT."
(ede-name object))
-(defmethod eieio-speedbar-object-children ((this ede-project))
+(cl-defmethod eieio-speedbar-object-children ((this ede-project))
"Return the list of speedbar display children for THIS."
(condition-case nil
(with-slots (subproj targets) this
(append subproj targets))
(error nil)))
-(defmethod eieio-speedbar-object-children ((this ede-target))
+(cl-defmethod eieio-speedbar-object-children ((this ede-target))
"Return the list of speedbar display children for THIS."
(oref this source))
-(defmethod eieio-speedbar-child-make-tag-lines ((this ede-target) depth)
+(cl-defmethod eieio-speedbar-child-make-tag-lines ((this ede-target) depth)
"Create a speedbar tag line for a child of THIS.
It has depth DEPTH."
(with-slots (source) this
(project-update-version ede-object)
(ede-update-version-in-source ede-object newversion))))
-(defmethod project-update-version ((ot ede-project))
+(cl-defmethod project-update-version ((ot ede-project))
"The :version of the project OT has been updated.
Handle saving, or other detail."
(error "project-update-version not supported by %s" (eieio-object-name ot)))
-(defmethod ede-update-version-in-source ((this ede-project) version)
+(cl-defmethod ede-update-version-in-source ((this ede-project) version)
"Change occurrences of a version string in sources.
In project THIS, cycle over all targets to give them a chance to set
their sources to VERSION."
(ede-map-targets this (lambda (targ)
(ede-update-version-in-source targ version))))
-(defmethod ede-update-version-in-source ((this ede-target) version)
+(cl-defmethod ede-update-version-in-source ((this ede-target) version)
"In sources for THIS, change version numbers to VERSION."
(if (and (slot-boundp this 'versionsource)
(oref this versionsource))
;;
;; Simple methods against the context classes.
;;
-(defmethod semantic-analyze-type-constraint
+(cl-defmethod semantic-analyze-type-constraint
((context semantic-analyze-context) &optional desired-type)
"Return a type constraint for completing :prefix in CONTEXT.
Optional argument DESIRED-TYPE may be a non-type tag to analyze."
)
desired-type))
-(defmethod semantic-analyze-type-constraint
+(cl-defmethod semantic-analyze-type-constraint
((context semantic-analyze-context-functionarg))
"Return a type constraint for completing :prefix in CONTEXT."
- (call-next-method context (car (oref context argument))))
+ (cl-call-next-method context (car (oref context argument))))
-(defmethod semantic-analyze-type-constraint
+(cl-defmethod semantic-analyze-type-constraint
((context semantic-analyze-context-assignment))
"Return a type constraint for completing :prefix in CONTEXT."
- (call-next-method context (car (reverse (oref context assignee)))))
+ (cl-call-next-method context (car (reverse (oref context assignee)))))
-(defmethod semantic-analyze-interesting-tag
+(cl-defmethod semantic-analyze-interesting-tag
((context semantic-analyze-context))
"Return a tag from CONTEXT that would be most interesting to a user."
(let ((prefix (reverse (oref context :prefix))))
;; Return the found tag, or nil.
(car prefix)))
-(defmethod semantic-analyze-interesting-tag
+(cl-defmethod semantic-analyze-interesting-tag
((context semantic-analyze-context-functionarg))
"Try the base, and if that fails, return what we are assigning into."
- (or (call-next-method) (car-safe (oref context :function))))
+ (or (cl-call-next-method) (car-safe (oref context :function))))
-(defmethod semantic-analyze-interesting-tag
+(cl-defmethod semantic-analyze-interesting-tag
((context semantic-analyze-context-assignment))
"Try the base, and if that fails, return what we are assigning into."
- (or (call-next-method) (car-safe (oref context :assignee))))
+ (or (cl-call-next-method) (car-safe (oref context :assignee))))
;;; ANALYSIS
;;
;;
(declare-function pulse-momentary-highlight-region "pulse")
-(defmethod semantic-analyze-pulse ((context semantic-analyze-context))
+(cl-defmethod semantic-analyze-pulse ((context semantic-analyze-context))
"Pulse the region that CONTEXT affects."
(require 'pulse)
(with-current-buffer (oref context :buffer)
(setq prefix (make-string (length prefix) ? ))
))
-(defmethod semantic-analyze-show ((context semantic-analyze-context))
+(cl-defmethod semantic-analyze-show ((context semantic-analyze-context))
"Insert CONTEXT into the current buffer in a nice way."
(semantic-analyze-princ-sequence (oref context prefix) "Prefix: " )
(semantic-analyze-princ-sequence (oref context prefixclass) "Prefix Classes: ")
(semantic-analyze-show (oref context scope)))
)
-(defmethod semantic-analyze-show ((context semantic-analyze-context-assignment))
+(cl-defmethod semantic-analyze-show ((context semantic-analyze-context-assignment))
"Insert CONTEXT into the current buffer in a nice way."
(semantic-analyze-princ-sequence (oref context assignee) "Assignee: ")
- (call-next-method))
+ (cl-call-next-method))
-(defmethod semantic-analyze-show ((context semantic-analyze-context-functionarg))
+(cl-defmethod semantic-analyze-show ((context semantic-analyze-context-functionarg))
"Insert CONTEXT into the current buffer in a nice way."
(semantic-analyze-princ-sequence (oref context function) "Function: ")
(princ "Argument Index: ")
(princ (oref context index))
(princ "\n")
(semantic-analyze-princ-sequence (oref context argument) "Argument: ")
- (call-next-method))
+ (cl-call-next-method))
(defun semantic-analyze-pop-to-context (context)
"Display CONTEXT in a temporary buffer.
;;
;; These accessor methods will calculate the useful bits from the context, and cache values
;; into the context.
-(defmethod semantic-analyze-refs-impl ((refs semantic-analyze-references) &optional in-buffer)
+(cl-defmethod semantic-analyze-refs-impl ((refs semantic-analyze-references) &optional in-buffer)
"Return the implementations derived in the reference analyzer REFS.
Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer."
(let ((allhits (oref refs rawsearchdata))
allhits)
impl))
-(defmethod semantic-analyze-refs-proto ((refs semantic-analyze-references) &optional in-buffer)
+(cl-defmethod semantic-analyze-refs-proto ((refs semantic-analyze-references) &optional in-buffer)
"Return the prototypes derived in the reference analyzer REFS.
Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer."
(let ((allhits (oref refs rawsearchdata))
frame)
frame))
-(defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
+(cl-defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
"Highlight one parser frame."
(let* ((nonterm (oref frame nonterm))
(pb (oref semantic-debug-current-interface parser-buffer))
(oref frame lextoken))
))
-(defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
+(cl-defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
"Display info about this one parser frame."
(message "%S" (oref frame collection))
)
frame)
frame))
-(defmethod semantic-debug-frame-highlight ((frame semantic-bovine-debug-error-frame))
+(cl-defmethod semantic-debug-frame-highlight ((frame semantic-bovine-debug-error-frame))
"Highlight a frame from an action."
;; How do I get the location of the action in the source buffer?
)
-(defmethod semantic-debug-frame-info ((frame semantic-bovine-debug-error-frame))
+(cl-defmethod semantic-debug-frame-info ((frame semantic-bovine-debug-error-frame))
"Display info about the error thrown."
(message "Error: %S" (oref frame condition)))
The only options available for completion are those which can be logically
inserted into the current context.")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-analyze-completions) prefix completionlist)
"calculate the completions for prefix from completionlist."
;; if there are no completions yet, calculate them.
prefix
(oref obj first-pass-completions)))))
-(defmethod semantic-collector-cleanup ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-cleanup ((obj semantic-collector-abstract))
"Clean up any mess this collector may have."
nil)
-(defmethod semantic-collector-next-action
+(cl-defmethod semantic-collector-next-action
((obj semantic-collector-abstract) partial)
"What should we do next? OBJ can be used to determine the next action.
PARTIAL indicates if we are doing a partial completion."
'complete-whitespace)))
'complete))
-(defmethod semantic-collector-last-prefix= ((obj semantic-collector-abstract)
+(cl-defmethod semantic-collector-last-prefix= ((obj semantic-collector-abstract)
last-prefix)
"Return non-nil if OBJ's prefix matches PREFIX."
(and (slot-boundp obj 'last-prefix)
(string= (oref obj last-prefix) last-prefix)))
-(defmethod semantic-collector-get-cache ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-get-cache ((obj semantic-collector-abstract))
"Get the raw cache of tags for completion.
Calculate the cache if there isn't one."
(or (oref obj cache)
(semantic-collector-calculate-cache obj)))
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-abstract) prefix completionlist)
"Calculate the completions for prefix from completionlist.
Output must be in semanticdb Find result format."
(if result
(list (cons table result)))))
-(defmethod semantic-collector-calculate-completions
+(cl-defmethod semantic-collector-calculate-completions
((obj semantic-collector-abstract) prefix partial)
"Calculate completions for prefix as setup for other queries."
(let* ((case-fold-search semantic-case-fold)
)))
))
-(defmethod semantic-collector-try-completion-whitespace
+(cl-defmethod semantic-collector-try-completion-whitespace
((obj semantic-collector-abstract) prefix)
"For OBJ, do whitespace completion based on PREFIX.
This implies that if there are two completions, one matching
)))
-(defmethod semantic-collector-current-exact-match ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-current-exact-match ((obj semantic-collector-abstract))
"Return the active valid MATCH from the semantic collector.
For now, just return the first element from our list of available
matches. For semanticdb based results, make sure the file is loaded
(when (slot-boundp obj 'current-exact-match)
(oref obj current-exact-match)))
-(defmethod semantic-collector-current-whitespace-completion ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-current-whitespace-completion ((obj semantic-collector-abstract))
"Return the active whitespace completion value."
(when (slot-boundp obj 'last-whitespace-completion)
(oref obj last-whitespace-completion)))
-(defmethod semantic-collector-get-match ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-get-match ((obj semantic-collector-abstract))
"Return the active valid MATCH from the semantic collector.
For now, just return the first element from our list of available
matches. For semanticdb based results, make sure the file is loaded
(when (slot-boundp obj 'current-exact-match)
(semanticdb-find-result-nth-in-buffer (oref obj current-exact-match) 0)))
-(defmethod semantic-collector-all-completions
+(cl-defmethod semantic-collector-all-completions
((obj semantic-collector-abstract) prefix)
"For OBJ, retrieve all completions matching PREFIX.
The returned list consists of all the tags currently
(when (slot-boundp obj 'last-all-completions)
(oref obj last-all-completions)))
-(defmethod semantic-collector-try-completion
+(cl-defmethod semantic-collector-try-completion
((obj semantic-collector-abstract) prefix)
"For OBJ, attempt to match PREFIX.
See `try-completion' for details on how this works.
(if (slot-boundp obj 'last-completion)
(oref obj last-completion)))
-(defmethod semantic-collector-calculate-cache
+(cl-defmethod semantic-collector-calculate-cache
((obj semantic-collector-abstract))
"Calculate the completion cache for OBJ."
nil
)
-(defmethod semantic-collector-flush ((this semantic-collector-abstract))
+(cl-defmethod semantic-collector-flush ((this semantic-collector-abstract))
"Flush THIS collector object, clearing any caches and prefix."
(oset this cache nil)
(slot-makeunbound this 'last-prefix)
These collectors track themselves on a per-buffer basis."
:abstract t)
-(defmethod constructor :STATIC ((this semantic-collector-buffer-abstract)
+(cl-defmethod constructor ((this (subclass semantic-collector-buffer-abstract))
newname &rest fields)
"Reuse previously created objects of this type in buffer."
(let ((old nil)
(if (eq (eieio-object-class (car bl)) this)
(setq old (car bl))))
(unless old
- (let ((new (call-next-method)))
+ (let ((new (cl-call-next-method)))
(add-to-list 'semantic-collector-per-buffer-list new)
(setq old new)))
(slot-makeunbound old 'last-completion)
When searching for a tag, uses semantic deep search functions.
Basics search only in the current buffer.")
-(defmethod semantic-collector-calculate-cache
+(cl-defmethod semantic-collector-calculate-cache
((obj semantic-collector-buffer-deep))
"Calculate the completion cache for OBJ.
Uses `semantic-flatten-tags-table'"
"Completion engine for tags in a project.")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-project) prefix completionlist)
"Calculate the completions for prefix from completionlist."
(semanticdb-find-tags-for-completion prefix (oref obj path)))
(declare-function semanticdb-brute-deep-find-tags-for-completion
"semantic/db-find")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-project-brutish) prefix completionlist)
"Calculate the completions for prefix from completionlist."
(require 'semantic/db-find)
"The scope the local members are being completed from."))
"Completion engine for tags in a project.")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-local-members) prefix completionlist)
"Calculate the completions for prefix from completionlist."
(let* ((scope (or (oref obj scope)
a collector, and tracking tables of completion to display."
:abstract t)
-(defmethod semantic-displayor-cleanup ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-cleanup ((obj semantic-displayor-abstract))
"Clean up any mess this displayor may have."
nil)
-(defmethod semantic-displayor-next-action ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-next-action ((obj semantic-displayor-abstract))
"The next action to take on the minibuffer related to display."
(if (and (slot-boundp obj 'last-prefix)
(or (eq this-command 'semantic-complete-inline-TAB)
'scroll
'display))
-(defmethod semantic-displayor-set-completions ((obj semantic-displayor-abstract)
+(cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-abstract)
table prefix)
"Set the list of tags to be completed over to TABLE."
(oset obj table table)
(oset obj last-prefix prefix))
-(defmethod semantic-displayor-show-request ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-abstract))
"A request to show the current tags table."
(ding))
-(defmethod semantic-displayor-focus-request ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-focus-request ((obj semantic-displayor-abstract))
"A request to for the displayor to focus on some tag option."
(ding))
-(defmethod semantic-displayor-scroll-request ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-scroll-request ((obj semantic-displayor-abstract))
"A request to for the displayor to scroll the completion list (if needed)."
(scroll-other-window))
-(defmethod semantic-displayor-focus-previous ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-focus-previous ((obj semantic-displayor-abstract))
"Set the current focus to the previous item."
nil)
-(defmethod semantic-displayor-focus-next ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-focus-next ((obj semantic-displayor-abstract))
"Set the current focus to the next item."
nil)
-(defmethod semantic-displayor-current-focus ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-current-focus ((obj semantic-displayor-abstract))
"Return a single tag currently in focus.
This object type doesn't do focus, so will never have a focus object."
nil)
Completions are showin in a new buffer and listed with the ability
to click on the items to aid in completion.")
-(defmethod semantic-displayor-show-request ((obj semantic-displayor-traditional))
+(cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-traditional))
"A request to show the current tags table."
;; NOTE TO SELF. Find the character to type next, and emphasize it.
which have the same name."
:abstract t)
-(defmethod semantic-displayor-next-action ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-next-action ((obj semantic-displayor-focus-abstract))
"The next action to take on the minibuffer related to display."
(if (and (slot-boundp obj 'last-prefix)
(string= (oref obj last-prefix) (semantic-completion-text))
'focus)
'display))
-(defmethod semantic-displayor-set-completions ((obj semantic-displayor-focus-abstract)
+(cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-focus-abstract)
table prefix)
"Set the list of tags to be completed over to TABLE."
- (call-next-method)
+ (cl-call-next-method)
(slot-makeunbound obj 'focus))
-(defmethod semantic-displayor-focus-previous ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-focus-previous ((obj semantic-displayor-focus-abstract))
"Set the current focus to the previous item.
Not meaningful return value."
(when (and (slot-boundp obj 'table) (oref obj table))
)
)))
-(defmethod semantic-displayor-focus-next ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-focus-next ((obj semantic-displayor-focus-abstract))
"Set the current focus to the next item.
Not meaningful return value."
(when (and (slot-boundp obj 'table) (oref obj table))
(oset obj focus 0))
)))
-(defmethod semantic-displayor-focus-tag ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-focus-tag ((obj semantic-displayor-focus-abstract))
"Return the next tag OBJ should focus on."
(when (and (slot-boundp obj 'table) (oref obj table))
(with-slots (table) obj
(semanticdb-find-result-nth table (oref obj focus)))))
-(defmethod semantic-displayor-current-focus ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-current-focus ((obj semantic-displayor-focus-abstract))
"Return the tag currently in focus, or call parent method."
(if (and (slot-boundp obj 'focus)
(slot-boundp obj 'table)
;; database.
(car (semanticdb-find-result-nth (oref obj table) (oref obj focus))))
;; Do whatever
- (call-next-method)))
+ (cl-call-next-method)))
;;; Simple displayor which performs traditional display completion,
;; and also focuses with highlighting.
multiple tags with the same name done by 'focusing' on the source
location of the different tags to differentiate them.")
-(defmethod semantic-displayor-focus-request
+(cl-defmethod semantic-displayor-focus-request
((obj semantic-displayor-traditional-with-focus-highlight))
"Focus in on possible tag completions.
Focus is performed by cycling through the tags and highlighting
"Display completions options in a tooltip.
Display mechanism using tooltip for a list of possible completions.")
-(defmethod initialize-instance :AFTER ((obj semantic-displayor-tooltip) &rest args)
+(cl-defmethod initialize-instance :after ((obj semantic-displayor-tooltip) &rest args)
"Make sure we have tooltips required."
(condition-case nil
(require 'tooltip)
(defvar tooltip-mode)
-(defmethod semantic-displayor-show-request ((obj semantic-displayor-tooltip))
+(cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-tooltip))
"A request to show the current tags table."
(if (or (not (featurep 'tooltip)) (not tooltip-mode))
;; If we cannot use tooltips, then go to the normal mode with
;; a traditional completion buffer.
- (call-next-method)
+ (cl-call-next-method)
(let* ((tablelong (semanticdb-strip-find-results (oref obj table)))
(table (semantic-unique-tag-table-by-name tablelong))
(completions (mapcar semantic-completion-displayor-format-tag-function table))
tooltip-frame-parameters)
(tooltip-show text)))
-(defmethod semantic-displayor-scroll-request ((obj semantic-displayor-tooltip))
+(cl-defmethod semantic-displayor-scroll-request ((obj semantic-displayor-tooltip))
"A request to for the displayor to scroll the completion list (if needed)."
;; Do scrolling in the tooltip.
(oset obj max-tags-initial 30)
Whichever completion is currently in focus will be displayed as ghost
text using overlay options.")
-(defmethod semantic-displayor-next-action ((obj semantic-displayor-ghost))
+(cl-defmethod semantic-displayor-next-action ((obj semantic-displayor-ghost))
"The next action to take on the inline completion related to display."
- (let ((ans (call-next-method))
+ (let ((ans (cl-call-next-method))
(table (when (slot-boundp obj 'table)
(oref obj table))))
(if (and (eq ans 'displayend)
nil
ans)))
-(defmethod semantic-displayor-cleanup ((obj semantic-displayor-ghost))
+(cl-defmethod semantic-displayor-cleanup ((obj semantic-displayor-ghost))
"Clean up any mess this displayor may have."
(when (slot-boundp obj 'ghostoverlay)
(semantic-overlay-delete (oref obj ghostoverlay)))
)
-(defmethod semantic-displayor-set-completions ((obj semantic-displayor-ghost)
+(cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-ghost)
table prefix)
"Set the list of tags to be completed over to TABLE."
- (call-next-method)
+ (cl-call-next-method)
(semantic-displayor-cleanup obj)
)
-(defmethod semantic-displayor-show-request ((obj semantic-displayor-ghost))
+(cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-ghost))
"A request to show the current tags table."
; (if (oref obj first-show)
; (progn
;; Only do the traditional thing if the first show request
;; has been seen. Use the first one to start doing the ghost
;; text display.
-; (call-next-method)
+; (cl-call-next-method)
; )
)
-(defmethod semantic-displayor-focus-request
+(cl-defmethod semantic-displayor-focus-request
((obj semantic-displayor-ghost))
"Focus in on possible tag completions.
Focus is performed by cycling through the tags and showing a possible
()
"Search Ebrowse for symbols.")
-(defmethod semanticdb-needs-refresh-p ((table semanticdb-table-ebrowse))
+(cl-defmethod semanticdb-needs-refresh-p ((table semanticdb-table-ebrowse))
"EBROWSE database do not need to be refreshed.
JAVE: stub for needs-refresh, because, how do we know if BROWSE files
;;; Methods for creating a database or tables
;;
-(defmethod semanticdb-create-database :STATIC ((dbeC semanticdb-project-database-ebrowse)
+(cl-defmethod semanticdb-create-database ((dbeC (subclass semanticdb-project-database-ebrowse))
directory)
"Create a new semantic database for DIRECTORY based on ebrowse.
If there is no database for DIRECTORY available, then
db)))
-(defmethod semanticdb-ebrowse-strip-trees ((dbe semanticdb-project-database-ebrowse)
+(cl-defmethod semanticdb-ebrowse-strip-trees ((dbe semanticdb-project-database-ebrowse)
data)
"For the ebrowse database DBE, strip all tables from DATA."
;JAVE what it actually seems to do is split the original tree in "tables" associated with files
;;;
;; Overload for converting the simple faux tag into something better.
;;
-(defmethod semanticdb-normalize-tags ((obj semanticdb-table-ebrowse) tags)
+(cl-defmethod semanticdb-normalize-tags ((obj semanticdb-table-ebrowse) tags)
"Convert in Ebrowse database OBJ a list of TAGS into a complete tag.
The default tag provided by searches exclude many features of a
semantic parsed tag. Look up the file for OBJ, and match TAGS
(setq tags (cdr tags))))
tagret))
-(defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-ebrowse) tag)
+(cl-defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-ebrowse) tag)
"Convert in Ebrowse database OBJ one TAG into a complete tag.
The default tag provided by searches exclude many features of a
semantic parsed tag. Look up the file for OBJ, and match TAG
;; NOTE WHEN IMPLEMENTING: Be sure to add doc-string updates explaining
;; how your new search routines are implemented.
;;
-(defmethod semanticdb-find-tags-by-name-method
+(cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-ebrowse) name &optional tags)
"Find all tags named NAME in TABLE.
Return a list of tags."
;;(message "semanticdb-find-tags-by-name-method name -- %s" name)
(if tags
;; If TAGS are passed in, then we don't need to do work here.
- (call-next-method)
+ (cl-call-next-method)
;; If we ever need to do something special, add here.
;; Since ebrowse tags are converted into semantic tags, we can
;; get away with this sort of thing.
- (call-next-method)
+ (cl-call-next-method)
)
)
-(defmethod semanticdb-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-ebrowse) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
- (call-next-method)
+ (cl-call-next-method)
))
-(defmethod semanticdb-find-tags-for-completion-method
+(cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-ebrowse) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
- (call-next-method)
+ (cl-call-next-method)
))
-(defmethod semanticdb-find-tags-by-class-method
+(cl-defmethod semanticdb-find-tags-by-class-method
((table semanticdb-table-ebrowse) class &optional tags)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
- (call-next-method)))
+ (if tags (cl-call-next-method)
+ (cl-call-next-method)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; above.
;;
-(defmethod semanticdb-deep-find-tags-by-name-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-ebrowse) name &optional tags)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for ebrowse."
;;(semanticdb-find-tags-by-name-method table name tags)
- (call-next-method))
+ (cl-call-next-method))
-(defmethod semanticdb-deep-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-ebrowse) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for ebrowse."
;;(semanticdb-find-tags-by-name-regexp-method table regex tags)
- (call-next-method))
+ (cl-call-next-method))
-(defmethod semanticdb-deep-find-tags-for-completion-method
+(cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-ebrowse) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-for-completion-method' for ebrowse."
;;(semanticdb-find-tags-for-completion-method table prefix tags)
- (call-next-method))
+ (cl-call-next-method))
;;; Advanced Searches
;;
-(defmethod semanticdb-find-tags-external-children-of-type-method
+(cl-defmethod semanticdb-find-tags-external-children-of-type-method
((table semanticdb-table-ebrowse) type &optional tags)
"Find all nonterminals which are child elements of TYPE
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; Ebrowse collects all this type of stuff together for us.
;; but we can't use it.... yet.
nil
)
"A table for returning search results from Emacs.")
-(defmethod semanticdb-refresh-table ((obj semanticdb-table-emacs-lisp) &optional force)
+(cl-defmethod semanticdb-refresh-table ((obj semanticdb-table-emacs-lisp) &optional force)
"Do not refresh Emacs Lisp table.
It does not need refreshing."
nil)
-(defmethod semanticdb-needs-refresh-p ((obj semanticdb-table-emacs-lisp))
+(cl-defmethod semanticdb-needs-refresh-p ((obj semanticdb-table-emacs-lisp))
"Return nil, we never need a refresh."
nil)
-(defmethod object-print ((obj semanticdb-table-emacs-lisp) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-table-emacs-lisp) &rest strings)
"Pretty printer extension for `semanticdb-table-emacs-lisp'.
Adds the number of tags in this file to the object print name."
(apply 'call-next-method obj (cons " (proxy)" strings)))
)
"Database representing Emacs core.")
-(defmethod object-print ((obj semanticdb-project-database-emacs-lisp) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-project-database-emacs-lisp) &rest strings)
"Pretty printer extension for `semanticdb-table-emacs-lisp'.
Adds the number of tags in this file to the object print name."
(let ((count 0))
;;; Filename based methods
;;
-(defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-emacs-lisp))
+(cl-defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-emacs-lisp))
"For an Emacs Lisp database, there are no explicit tables.
Create one of our special tables that can act as an intermediary."
;; We need to return something since there is always the "master table"
(oset newtable parent-db obj)
(oset newtable tags nil)
))
- (call-next-method))
+ (cl-call-next-method))
-(defmethod semanticdb-file-table ((obj semanticdb-project-database-emacs-lisp) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-emacs-lisp) filename)
"From OBJ, return FILENAME's associated table object.
For Emacs Lisp, creates a specialized table."
(car (semanticdb-get-database-tables obj))
)
-(defmethod semanticdb-get-tags ((table semanticdb-table-emacs-lisp ))
+(cl-defmethod semanticdb-get-tags ((table semanticdb-table-emacs-lisp ))
"Return the list of tags belonging to TABLE."
;; specialty table ? Probably derive tags at request time.
nil)
-(defmethod semanticdb-equivalent-mode ((table semanticdb-table-emacs-lisp) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-emacs-lisp) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
(with-current-buffer buffer
(eq (or mode-local-active-mode major-mode) 'emacs-lisp-mode)))
-(defmethod semanticdb-full-filename ((obj semanticdb-table-emacs-lisp))
+(cl-defmethod semanticdb-full-filename ((obj semanticdb-table-emacs-lisp))
"Fetch the full filename that OBJ refers to.
For Emacs Lisp system DB, there isn't one."
nil)
;;; Conversion
;;
-(defmethod semanticdb-normalize-tags ((obj semanticdb-table-emacs-lisp) tags)
+(cl-defmethod semanticdb-normalize-tags ((obj semanticdb-table-emacs-lisp) tags)
"Convert tags, originating from Emacs OBJ, into standardized form."
(let ((newtags nil))
(dolist (T tags)
;; There is no promise to have files associated.
(nreverse newtags)))
-(defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-emacs-lisp) tag)
+(cl-defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-emacs-lisp) tag)
"Convert one TAG, originating from Emacs OBJ, into standardized form.
If Emacs cannot resolve this symbol to a particular file, then return nil."
;; Here's the idea. For each tag, get the name, then use
(symbol-name sym)
"class"
(semantic-elisp-desymbolify
- ;; FIXME: This only gives the instance slots and ignores the
- ;; class-allocated slots.
- (eieio--class-public-a (find-class 'semanticdb-project-database))) ;; slots ;FIXME: eieio--
+ (let ((class (find-class sym)))
+ (if (fboundp 'eieio-slot-descriptor-name)
+ (mapcar #'eieio-slot-descriptor-name
+ (eieio-class-slots class))
+ (eieio--class-public-a class))))
(semantic-elisp-desymbolify (eieio-class-parents sym)) ;; parents
))
((not toktype)
(defvar semanticdb-elisp-mapatom-collector nil
"Variable used to collect `mapatoms' output.")
-(defmethod semanticdb-find-tags-by-name-method
+(cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-emacs-lisp) name &optional tags)
"Find all tags named NAME in TABLE.
Uses `intern-soft' to match NAME to Emacs symbols.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; No need to search. Use `intern-soft' which does the same thing for us.
(let* ((sym (intern-soft name))
(fun (semanticdb-elisp-sym->tag sym 'function))
taglst
))))
-(defmethod semanticdb-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-emacs-lisp) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Uses `apropos-internal' to find matches.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
(delq nil (mapcar 'semanticdb-elisp-sym->tag
(apropos-internal regex)))))
-(defmethod semanticdb-find-tags-for-completion-method
+(cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-emacs-lisp) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
(delq nil (mapcar 'semanticdb-elisp-sym->tag
(all-completions prefix obarray)))))
-(defmethod semanticdb-find-tags-by-class-method
+(cl-defmethod semanticdb-find-tags-by-class-method
((table semanticdb-table-emacs-lisp) class &optional tags)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; We could implement this, but it could be messy.
nil))
;;; Deep Searches
;;
;; For Emacs Lisp deep searches are like top level searches.
-(defmethod semanticdb-deep-find-tags-by-name-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-emacs-lisp) name &optional tags)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for Emacs Lisp."
(semanticdb-find-tags-by-name-method table name tags))
-(defmethod semanticdb-deep-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-emacs-lisp) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for Emacs Lisp."
(semanticdb-find-tags-by-name-regexp-method table regex tags))
-(defmethod semanticdb-deep-find-tags-for-completion-method
+(cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-emacs-lisp) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
;;; Advanced Searches
;;
-(defmethod semanticdb-find-tags-external-children-of-type-method
+(cl-defmethod semanticdb-find-tags-external-children-of-type-method
((table semanticdb-table-emacs-lisp) type &optional tags)
"Find all nonterminals which are child elements of TYPE
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; EIEIO is the only time this matters
(when (featurep 'eieio)
(let* ((class (intern-soft type))
;;; Code:
;;
-(defmethod semanticdb-create-database :STATIC ((dbc semanticdb-project-database-file)
+(cl-defmethod semanticdb-create-database ((dbc (subclass semanticdb-project-database-file))
directory)
"Create a new semantic database for DIRECTORY and return it.
If a database for DIRECTORY has already been loaded, return it.
"Return the project belonging to FILENAME if it was already loaded."
(eieio-instance-tracker-find filename 'file 'semanticdb-database-list))
-(defmethod semanticdb-file-directory-exists-p ((DB semanticdb-project-database-file)
+(cl-defmethod semanticdb-file-directory-exists-p ((DB semanticdb-project-database-file)
&optional suppress-questions)
"Does the directory the database DB needs to write to exist?
If SUPPRESS-QUESTIONS, then do not ask to create the directory."
(setq semanticdb--inhibit-make-directory t))
nil))))
-(defmethod semanticdb-save-db ((DB semanticdb-project-database-file)
+(cl-defmethod semanticdb-save-db ((DB semanticdb-project-database-file)
&optional
suppress-questions)
"Write out the database DB to its file.
)
))
-(defmethod semanticdb-live-p ((obj semanticdb-project-database))
+(cl-defmethod semanticdb-live-p ((obj semanticdb-project-database))
"Return non-nil if the file associated with OBJ is live.
Live databases are objects associated with existing directories."
(and (slot-boundp obj 'reference-directory)
(file-exists-p (oref obj reference-directory))))
-(defmethod semanticdb-live-p ((obj semanticdb-table))
+(cl-defmethod semanticdb-live-p ((obj semanticdb-table))
"Return non-nil if the file associated with OBJ is live.
Live files are either buffers in Emacs, or files existing on the filesystem."
(let ((full-filename (semanticdb-full-filename obj)))
(declare-function data-debug-insert-thing "data-debug")
-(defmethod object-write ((obj semanticdb-table))
+(cl-defmethod object-write ((obj semanticdb-table))
"When writing a table, we have to make sure we deoverlay it first.
Restore the overlays after writing.
Argument OBJ is the object to write."
;; Do it!
(condition-case tableerror
- (call-next-method)
+ (cl-call-next-method)
(error
(when semanticdb-data-debug-on-write-error
(require 'data-debug)
;;; State queries
;;
-(defmethod semanticdb-write-directory-p ((obj semanticdb-project-database-file))
+(cl-defmethod semanticdb-write-directory-p ((obj semanticdb-project-database-file))
"Return non-nil if OBJ should be written to disk.
Uses `semanticdb-persistent-path' to determine the return value."
(let ((path semanticdb-persistent-path))
(throw 'found t))
(t (error "Invalid path %S" (car path))))
(setq path (cdr path)))
- (call-next-method))
+ (cl-call-next-method))
))
;;; Filename manipulation
;;
-(defmethod semanticdb-file-table ((obj semanticdb-project-database-file) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-file) filename)
"From OBJ, return FILENAME's associated table object."
;; Cheater option. In this case, we always have files directly
;; under ourselves. The main project type may not.
(object-assoc (file-name-nondirectory filename) 'file (oref obj tables)))
-(defmethod semanticdb-file-name-non-directory :STATIC
- ((dbclass semanticdb-project-database-file))
+(cl-defmethod semanticdb-file-name-non-directory
+ ((dbclass (subclass semanticdb-project-database-file)))
"Return the file name DBCLASS will use.
File name excludes any directory part."
semanticdb-default-file-name)
-(defmethod semanticdb-file-name-directory :STATIC
- ((dbclass semanticdb-project-database-file) directory)
+(cl-defmethod semanticdb-file-name-directory
+ ((dbclass (subclass semanticdb-project-database-file)) directory)
"Return the relative directory to where DBCLASS will save its cache file.
The returned path is related to DIRECTORY."
(if semanticdb-default-save-directory
file (file-name-as-directory semanticdb-default-save-directory)))
directory))
-(defmethod semanticdb-cache-filename :STATIC
- ((dbclass semanticdb-project-database-file) path)
+(cl-defmethod semanticdb-cache-filename
+ ((dbclass (subclass semanticdb-project-database-file)) path)
"For DBCLASS, return a file to a cache file belonging to PATH.
This could be a cache file in the current directory, or an encoded file
name in a secondary directory."
(concat (semanticdb-file-name-directory dbclass path)
(semanticdb-file-name-non-directory dbclass)))
-(defmethod semanticdb-full-filename ((obj semanticdb-project-database-file))
+(cl-defmethod semanticdb-full-filename ((obj semanticdb-project-database-file))
"Fetch the full filename that OBJ refers to."
(oref obj file))
"Concrete search index for `semanticdb-find'.
This class will cache data derived during various searches.")
-(defmethod semantic-reset ((idx semanticdb-find-search-index))
+(cl-defmethod semantic-reset ((idx semanticdb-find-search-index))
"Reset the object IDX."
(require 'semantic/scope)
;; Clear the include path.
(semantic-scope-reset-cache)
)
-(defmethod semanticdb-synchronize ((idx semanticdb-find-search-index)
+(cl-defmethod semanticdb-synchronize ((idx semanticdb-find-search-index)
new-tags)
"Synchronize the search index IDX with some NEW-TAGS."
;; Reset our parts.
(semantic-reset (semanticdb-get-table-index tab))))
)
-(defmethod semanticdb-partial-synchronize ((idx semanticdb-find-search-index)
+(cl-defmethod semanticdb-partial-synchronize ((idx semanticdb-find-search-index)
new-tags)
"Synchronize the search index IDX with some changed NEW-TAGS."
;; Only reset if include statements changed.
;; Override these with system databases to as new types of back ends.
;;; Top level Searches
-(defmethod semanticdb-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags)
+(cl-defmethod semanticdb-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags)
"In TABLE, find all occurrences of tags with NAME.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(semantic-find-tags-by-name name (or tags (semanticdb-get-tags table))))
-(defmethod semanticdb-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags)
+(cl-defmethod semanticdb-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags)
"In TABLE, find all occurrences of tags matching REGEXP.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(semantic-find-tags-by-name-regexp regexp (or tags (semanticdb-get-tags table))))
-(defmethod semanticdb-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags)
+(cl-defmethod semanticdb-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(semantic-find-tags-for-completion prefix (or tags (semanticdb-get-tags table))))
-(defmethod semanticdb-find-tags-by-class-method ((table semanticdb-abstract-table) class &optional tags)
+(cl-defmethod semanticdb-find-tags-by-class-method ((table semanticdb-abstract-table) class &optional tags)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(semantic-find-tags-included (or tags (semanticdb-get-tags table)))
(semantic-find-tags-by-class class (or tags (semanticdb-get-tags table)))))
-(defmethod semanticdb-find-tags-external-children-of-type-method ((table semanticdb-abstract-table) parent &optional tags)
+(cl-defmethod semanticdb-find-tags-external-children-of-type-method ((table semanticdb-abstract-table) parent &optional tags)
"In TABLE, find all occurrences of tags whose parent is the PARENT type.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(require 'semantic/find)
(semantic-find-tags-external-children-of-type parent (or tags (semanticdb-get-tags table))))
-(defmethod semanticdb-find-tags-subclasses-of-type-method ((table semanticdb-abstract-table) parent &optional tags)
+(cl-defmethod semanticdb-find-tags-subclasses-of-type-method ((table semanticdb-abstract-table) parent &optional tags)
"In TABLE, find all occurrences of tags whose parent is the PARENT type.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(semantic-find-tags-subclasses-of-type parent (or tags (semanticdb-get-tags table))))
;;; Deep Searches
-(defmethod semanticdb-deep-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags)
+(cl-defmethod semanticdb-deep-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags)
"In TABLE, find all occurrences of tags with NAME.
Search in all tags in TABLE, and all components of top level tags in
TABLE.
Return a table of all matching tags."
(semantic-find-tags-by-name name (semantic-flatten-tags-table (or tags (semanticdb-get-tags table)))))
-(defmethod semanticdb-deep-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags)
+(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags)
"In TABLE, find all occurrences of tags matching REGEXP.
Search in all tags in TABLE, and all components of top level tags in
TABLE.
Return a table of all matching tags."
(semantic-find-tags-by-name-regexp regexp (semantic-flatten-tags-table (or tags (semanticdb-get-tags table)))))
-(defmethod semanticdb-deep-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags)
+(cl-defmethod semanticdb-deep-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Search in all tags in TABLE, and all components of top level tags in
TABLE.
)
"A table for returning search results from GNU Global.")
-(defmethod object-print ((obj semanticdb-table-global) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-table-global) &rest strings)
"Pretty printer extension for `semanticdb-table-global'.
Adds the number of tags in this file to the object print name."
(apply 'call-next-method obj (cons " (proxy)" strings)))
-(defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer)
"Return t, pretend that this table's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
;;; Filename based methods
;;
-(defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-global))
+(cl-defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-global))
"For a global database, there are no explicit tables.
For each file hit, get the traditional semantic table from that file."
;; We need to return something since there is always the "master table"
(oset newtable tags nil)
))
- (call-next-method))
+ (cl-call-next-method))
-(defmethod semanticdb-file-table ((obj semanticdb-project-database-global) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-global) filename)
"From OBJ, return FILENAME's associated table object."
;; We pass in "don't load". I wonder if we need to avoid that or not?
(car (semanticdb-get-database-tables obj))
;;
;; Only NAME based searches work with GLOBAL as that is all it tracks.
;;
-(defmethod semanticdb-find-tags-by-name-method
+(cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-global) name &optional tags)
"Find all tags named NAME in TABLE.
Return a list of tags."
(if tags
;; If TAGS are passed in, then we don't need to do work here.
- (call-next-method)
+ (cl-call-next-method)
;; Call out to GNU Global for some results.
(let* ((semantic-symref-tool 'global)
(result (semantic-symref-find-tags-by-name name 'project))
(semantic-symref-result-get-tags result))
)))
-(defmethod semanticdb-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-global) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
(let* ((semantic-symref-tool 'global)
(result (semantic-symref-find-tags-by-regexp regex 'project))
)
(semantic-symref-result-get-tags result))
)))
-(defmethod semanticdb-find-tags-for-completion-method
+(cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-global) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
(let* ((semantic-symref-tool 'global)
(result (semantic-symref-find-tags-by-completion prefix 'project))
(faketags nil)
;; alone, otherwise replace with implementations similar to those
;; above.
;;
-(defmethod semanticdb-deep-find-tags-by-name-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-global) name &optional tags)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for global."
(semanticdb-find-tags-by-name-method table name tags))
-(defmethod semanticdb-deep-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-global) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for global."
(semanticdb-find-tags-by-name-regexp-method table regex tags))
-(defmethod semanticdb-deep-find-tags-for-completion-method
+(cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-global) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
;;; Filename based methods
;;
-(defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-javascript))
+(cl-defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-javascript))
"For a javascript database, there are no explicit tables.
Create one of our special tables that can act as an intermediary."
;; NOTE: This method overrides an accessor for the `tables' slot in
(oset newtable parent-db obj)
(oset newtable tags nil)
))
- (call-next-method)
+ (cl-call-next-method)
)
-(defmethod semanticdb-file-table ((obj semanticdb-project-database-javascript) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-javascript) filename)
"From OBJ, return FILENAME's associated table object."
;; NOTE: See not for `semanticdb-get-database-tables'.
(car (semanticdb-get-database-tables obj))
)
-(defmethod semanticdb-get-tags ((table semanticdb-table-javascript ))
+(cl-defmethod semanticdb-get-tags ((table semanticdb-table-javascript ))
"Return the list of tags belonging to TABLE."
;; NOTE: Omniscient databases probably don't want to keep large tables
;; lolly-gagging about. Keep internal Emacs tables empty and
;; refer to alternate databases when you need something.
semanticdb-javascript-tags)
-(defmethod semanticdb-equivalent-mode ((table semanticdb-table-javascript) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-javascript) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
(setq tags (cdr tags)))
result))
-(defmethod semanticdb-find-tags-by-name-method
+(cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-javascript) name &optional tags)
"Find all tags named NAME in TABLE.
Return a list of tags."
(if tags
;; If TAGS are passed in, then we don't need to do work here.
- (call-next-method)
+ (cl-call-next-method)
(assoc-string name semanticdb-javascript-tags)
))
-(defmethod semanticdb-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-javascript) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
(semanticdb-javascript-regexp-search regex)
))
-(defmethod semanticdb-find-tags-for-completion-method
+(cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-javascript) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
(semanticdb-javascript-regexp-search (concat "^" prefix ".*"))
))
-(defmethod semanticdb-find-tags-by-class-method
+(cl-defmethod semanticdb-find-tags-by-class-method
((table semanticdb-table-javascript) class &optional tags)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
;;
;; Note: This search method could be considered optional in an
;; alone, otherwise replace with implementations similar to those
;; above.
;;
-(defmethod semanticdb-deep-find-tags-by-name-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-javascript) name &optional tags)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for javascript."
(semanticdb-find-tags-by-name-method table name tags))
-(defmethod semanticdb-deep-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-javascript) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for javascript."
(semanticdb-find-tags-by-name-regexp-method table regex tags))
-(defmethod semanticdb-deep-find-tags-for-completion-method
+(cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-javascript) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
;;; Advanced Searches
;;
-(defmethod semanticdb-find-tags-external-children-of-type-method
+(cl-defmethod semanticdb-find-tags-external-children-of-type-method
((table semanticdb-table-javascript) type &optional tags)
"Find all nonterminals which are child elements of TYPE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
;;
;; OPTIONAL: This could be considered an optional function. It is
;;; Code:
(require 'eieio)
+(require 'cl-generic)
(require 'semantic)
(require 'semantic/db)
(require 'semantic/tag)
;; For the semantic-find-tags-by-name-regexp macro.
(eval-when-compile (require 'semantic/find))
-(defmethod semanticdb-add-reference ((dbt semanticdb-abstract-table)
+(cl-defmethod semanticdb-add-reference ((dbt semanticdb-abstract-table)
include-tag)
"Add a reference for the database table DBT based on INCLUDE-TAG.
DBT is the database table that owns the INCLUDE-TAG. The reference
(object-add-to-list refdbt 'db-refs dbt)
t)))
-(defmethod semanticdb-check-references ((dbt semanticdb-abstract-table))
+(cl-defmethod semanticdb-check-references ((dbt semanticdb-abstract-table))
"Check and cleanup references in the database DBT.
Abstract tables would be difficult to reference."
;; Not sure how an abstract table can have references.
nil)
-(defmethod semanticdb-includes-in-table ((dbt semanticdb-abstract-table))
+(cl-defmethod semanticdb-includes-in-table ((dbt semanticdb-abstract-table))
"Return a list of direct includes in table DBT."
(semantic-find-tags-by-class 'include (semanticdb-get-tags dbt)))
-(defmethod semanticdb-check-references ((dbt semanticdb-table))
+(cl-defmethod semanticdb-check-references ((dbt semanticdb-table))
"Check and cleanup references in the database DBT.
Any reference to a file that cannot be found, or whos file no longer
refers to DBT will be removed."
))
(setq refs (cdr refs)))))
-(defmethod semanticdb-refresh-references ((dbt semanticdb-abstract-table))
+(cl-defmethod semanticdb-refresh-references ((dbt semanticdb-abstract-table))
"Refresh references to DBT in other files."
;; alternate tables can't be edited, so can't be changed.
nil
)
-(defmethod semanticdb-refresh-references ((dbt semanticdb-table))
+(cl-defmethod semanticdb-refresh-references ((dbt semanticdb-table))
"Refresh references to DBT in other files."
(let ((refs (semanticdb-includes-in-table dbt))
)
(setq refs (cdr refs)))
))
-(defmethod semanticdb-notify-references ((dbt semanticdb-table)
+(cl-defmethod semanticdb-notify-references ((dbt semanticdb-table)
method)
"Notify all references of the table DBT using method.
METHOD takes two arguments.
)
"Structure for maintaining a typecache.")
-(defmethod semantic-reset ((tc semanticdb-typecache))
+(cl-defmethod semantic-reset ((tc semanticdb-typecache))
"Reset the object IDX."
(oset tc filestream nil)
(oset tc includestream nil)
(oset tc dependants nil)
)
-(defmethod semanticdb-typecache-notify-reset ((tc semanticdb-typecache))
+(cl-defmethod semanticdb-typecache-notify-reset ((tc semanticdb-typecache))
"Do a reset from a notify from a table we depend on."
(oset tc includestream nil)
(mapc 'semantic-reset (oref tc dependants))
(oset tc dependants nil)
)
-(defmethod semanticdb-partial-synchronize ((tc semanticdb-typecache)
+(cl-defmethod semanticdb-partial-synchronize ((tc semanticdb-typecache)
new-tags)
"Reset the typecache based on a partial reparse."
(when (semantic-find-tags-by-class 'include new-tags)
(t -1) ))
-(defmethod semanticdb-get-typecache ((table semanticdb-abstract-table))
+(cl-defmethod semanticdb-get-typecache ((table semanticdb-abstract-table))
"Retrieve the typecache from the semanticdb TABLE.
If there is no table, create one, and fill it in."
(semanticdb-refresh-table table)
cache))
-(defmethod semanticdb-have-typecache-p ((table semanticdb-abstract-table))
+(cl-defmethod semanticdb-have-typecache-p ((table semanticdb-abstract-table))
"Return non-nil (the typecache) if TABLE has a pre-calculated typecache."
(let* ((idx (semanticdb-get-table-index table)))
(oref idx type-cache)))
)
"Structure for maintaining a typecache.")
-(defmethod semantic-reset ((tc semanticdb-database-typecache))
+(cl-defmethod semantic-reset ((tc semanticdb-database-typecache))
"Reset the object IDX."
(oset tc stream nil)
)
-(defmethod semanticdb-synchronize ((cache semanticdb-database-typecache)
+(cl-defmethod semanticdb-synchronize ((cache semanticdb-database-typecache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
)
-(defmethod semanticdb-partial-synchronize ((cache semanticdb-database-typecache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-database-typecache)
new-tags)
"Synchronize a CACHE with some changed NEW-TAGS."
)
-(defmethod semanticdb-get-typecache ((db semanticdb-project-database))
+(cl-defmethod semanticdb-get-typecache ((db semanticdb-project-database))
"Retrieve the typecache from the semantic database DB.
If there is no table, create one, and fill it in."
(semanticdb-cache-get db 'semanticdb-database-typecache)
namespaces instead."
tag)
-(defmethod semanticdb-typecache-file-tags ((table semanticdb-abstract-table))
+(cl-defmethod semanticdb-typecache-file-tags ((table semanticdb-abstract-table))
"No tags available from non-file based tables."
nil)
-(defmethod semanticdb-typecache-file-tags ((table semanticdb-table))
+(cl-defmethod semanticdb-typecache-file-tags ((table semanticdb-table))
"Update the typecache for TABLE, and return the file-tags.
File-tags are those that belong to this file only, and excludes
all included files."
(oref cache filestream)
))
-(defmethod semanticdb-typecache-include-tags ((table semanticdb-abstract-table))
+(cl-defmethod semanticdb-typecache-include-tags ((table semanticdb-abstract-table))
"No tags available from non-file based tables."
nil)
-(defmethod semanticdb-typecache-include-tags ((table semanticdb-table))
+(cl-defmethod semanticdb-typecache-include-tags ((table semanticdb-table))
"Update the typecache for TABLE, and return the merged types from the include tags.
Include-tags are the tags brought in via includes, all merged together into
a master list."
(types (semantic-find-tags-by-class 'type nmerge)))
(or (car-safe types) (car-safe nmerge))))
-(defmethod semanticdb-typecache-find-method ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-typecache-find-method ((table semanticdb-abstract-table)
type find-file-match)
"Search the typecache in TABLE for the datatype TYPE.
If type is a string, split the string, and search for the parts.
;;
;; Routines for a typecache that crosses all tables in a given database
;; for a matching major-mode.
-(defmethod semanticdb-typecache-for-database ((db semanticdb-project-database)
+(cl-defmethod semanticdb-typecache-for-database ((db semanticdb-project-database)
&optional mode)
"Return the typecache for the project database DB.
If there isn't one, create it.
for a new table not associated with a buffer."
:abstract t)
-(defmethod semanticdb-in-buffer-p ((obj semanticdb-abstract-table))
+(cl-defmethod semanticdb-in-buffer-p ((obj semanticdb-abstract-table))
"Return a nil, meaning abstract table OBJ is not in a buffer."
nil)
-(defmethod semanticdb-get-buffer ((obj semanticdb-abstract-table))
+(cl-defmethod semanticdb-get-buffer ((obj semanticdb-abstract-table))
"Return a buffer associated with OBJ.
If the buffer is not in memory, load it with `find-file-noselect'."
nil)
;; This generic method allows for sloppier coding. Many
;; functions treat "table" as something that could be a buffer,
;; file name, or other. This makes use of table more robust.
-(defmethod semanticdb-full-filename (buffer-or-string)
+(cl-defmethod semanticdb-full-filename (buffer-or-string)
"Fetch the full filename that BUFFER-OR-STRING refers to.
This uses semanticdb to get a better file name."
(cond ((bufferp buffer-or-string)
((and (stringp buffer-or-string) (file-exists-p buffer-or-string))
(expand-file-name buffer-or-string))))
-(defmethod semanticdb-full-filename ((obj semanticdb-abstract-table))
+(cl-defmethod semanticdb-full-filename ((obj semanticdb-abstract-table))
"Fetch the full filename that OBJ refers to.
Abstract tables do not have file names associated with them."
nil)
-(defmethod semanticdb-dirty-p ((obj semanticdb-abstract-table))
+(cl-defmethod semanticdb-dirty-p ((obj semanticdb-abstract-table))
"Return non-nil if OBJ is 'dirty'."
nil)
-(defmethod semanticdb-set-dirty ((obj semanticdb-abstract-table))
+(cl-defmethod semanticdb-set-dirty ((obj semanticdb-abstract-table))
"Mark the abstract table OBJ dirty.
Abstract tables can not be marked dirty, as there is nothing
for them to synchronize against."
;; The abstract table can not be dirty.
nil)
-(defmethod semanticdb-normalize-tags ((obj semanticdb-abstract-table) tags)
+(cl-defmethod semanticdb-normalize-tags ((obj semanticdb-abstract-table) tags)
"For the table OBJ, convert a list of TAGS, into standardized form.
The default is to return TAGS.
Some databases may default to searching and providing simplified tags
them to convert TAG into a more complete form."
tags)
-(defmethod semanticdb-normalize-one-tag ((obj semanticdb-abstract-table) tag)
+(cl-defmethod semanticdb-normalize-one-tag ((obj semanticdb-abstract-table) tag)
"For the table OBJ, convert a TAG, into standardized form.
This method returns a list of the form (DATABASE . NEWTAG).
them to convert TAG into a more complete form."
(cons obj tag))
-(defmethod object-print ((obj semanticdb-abstract-table) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-abstract-table) &rest strings)
"Pretty printer extension for `semanticdb-abstract-table'.
Adds the number of tags in this file to the object print name."
(if (or (not strings)
(and (= (length strings) 1) (stringp (car strings))
(string= (car strings) "")))
;; Else, add a tags quantifier.
- (call-next-method obj (format " (%d tags)" (length (semanticdb-get-tags obj))))
+ (cl-call-next-method obj (format " (%d tags)" (length (semanticdb-get-tags obj))))
;; Pass through.
(apply 'call-next-method obj strings)
))
needed, or perhaps create hash or index tables for the current buffer."
:abstract t)
-(defmethod semanticdb-get-table-index ((obj semanticdb-abstract-table))
+(cl-defmethod semanticdb-get-table-index ((obj semanticdb-abstract-table))
"Return the search index for the table OBJ.
If one doesn't exist, create it."
(if (slot-boundp obj 'index)
(oset obj index idx)
idx)))
-(defmethod semanticdb-synchronize ((idx semanticdb-abstract-search-index)
+(cl-defmethod semanticdb-synchronize ((idx semanticdb-abstract-search-index)
new-tags)
"Synchronize the search index IDX with some NEW-TAGS."
;; The abstract class will do... NOTHING!
)
-(defmethod semanticdb-partial-synchronize ((idx semanticdb-abstract-search-index)
+(cl-defmethod semanticdb-partial-synchronize ((idx semanticdb-abstract-search-index)
new-tags)
"Synchronize the search index IDX with some changed NEW-TAGS."
;; The abstract class will do... NOTHING!
Examples include search results from external sources such as from
Emacs's own symbol table, or from external libraries.")
-(defmethod semanticdb-refresh-table ((obj semanticdb-search-results-table) &optional force)
+(cl-defmethod semanticdb-refresh-table ((obj semanticdb-search-results-table) &optional force)
"If the tag list associated with OBJ is loaded, refresh it.
This will call `semantic-fetch-tags' if that file is in memory."
nil)
)
"A single table of tags derived from file.")
-(defmethod semanticdb-in-buffer-p ((obj semanticdb-table))
+(cl-defmethod semanticdb-in-buffer-p ((obj semanticdb-table))
"Return a buffer associated with OBJ.
If the buffer is in memory, return that buffer."
(let ((buff (oref obj buffer)))
buff
(oset obj buffer nil))))
-(defmethod semanticdb-get-buffer ((obj semanticdb-table))
+(cl-defmethod semanticdb-get-buffer ((obj semanticdb-table))
"Return a buffer associated with OBJ.
If the buffer is in memory, return that buffer.
If the buffer is not in memory, load it with `find-file-noselect'."
(save-match-data
(find-file-noselect (semanticdb-full-filename obj) t))))
-(defmethod semanticdb-set-buffer ((obj semanticdb-table))
+(cl-defmethod semanticdb-set-buffer ((obj semanticdb-table))
"Set the current buffer to be a buffer owned by OBJ.
If OBJ's file is not loaded, read it in first."
(set-buffer (semanticdb-get-buffer obj)))
-(defmethod semanticdb-full-filename ((obj semanticdb-table))
+(cl-defmethod semanticdb-full-filename ((obj semanticdb-table))
"Fetch the full filename that OBJ refers to."
(expand-file-name (oref obj file)
(oref (oref obj parent-db) reference-directory)))
-(defmethod semanticdb-dirty-p ((obj semanticdb-table))
+(cl-defmethod semanticdb-dirty-p ((obj semanticdb-table))
"Return non-nil if OBJ is 'dirty'."
(oref obj dirty))
-(defmethod semanticdb-set-dirty ((obj semanticdb-table))
+(cl-defmethod semanticdb-set-dirty ((obj semanticdb-table))
"Mark the abstract table OBJ dirty."
(oset obj dirty t)
)
-(defmethod object-print ((obj semanticdb-table) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-table) &rest strings)
"Pretty printer extension for `semanticdb-table'.
Adds the number of tags in this file to the object print name."
(apply 'call-next-method obj
:documentation "List of `semantic-db-table' objects."))
"Database of file tables.")
-(defmethod semanticdb-full-filename ((obj semanticdb-project-database))
+(cl-defmethod semanticdb-full-filename ((obj semanticdb-project-database))
"Fetch the full filename that OBJ refers to.
Abstract tables do not have file names associated with them."
nil)
-(defmethod semanticdb-dirty-p ((DB semanticdb-project-database))
+(cl-defmethod semanticdb-dirty-p ((DB semanticdb-project-database))
"Return non-nil if DB is 'dirty'.
A database is dirty if the state of the database changed in a way
where it may need to resynchronize with some persistent storage."
(setq tabs (cdr tabs)))
dirty))
-(defmethod object-print ((obj semanticdb-project-database) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-project-database) &rest strings)
"Pretty printer extension for `semanticdb-project-database'.
Adds the number of tables in this file to the object print name."
(apply 'call-next-method obj
)
strings)))
-(defmethod semanticdb-create-database :STATIC ((dbc semanticdb-project-database) directory)
+(cl-defmethod semanticdb-create-database ((dbc (subclass semanticdb-project-database)) directory)
"Create a new semantic database of class DBC for DIRECTORY and return it.
If a database for DIRECTORY has already been created, return it.
If DIRECTORY doesn't exist, create a new one."
(oset db reference-directory (file-truename directory)))
db))
-(defmethod semanticdb-flush-database-tables ((db semanticdb-project-database))
+(cl-defmethod semanticdb-flush-database-tables ((db semanticdb-project-database))
"Reset the tables in DB to be empty."
(oset db tables nil))
-(defmethod semanticdb-create-table ((db semanticdb-project-database) file)
+(cl-defmethod semanticdb-create-table ((db semanticdb-project-database) file)
"Create a new table in DB for FILE and return it.
The class of DB contains the class name for the type of table to create.
If the table for FILE exists, return it.
(object-add-to-list db 'tables newtab t))
newtab))
-(defmethod semanticdb-file-table ((obj semanticdb-project-database) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database) filename)
"From OBJ, return FILENAME's associated table object."
(object-assoc (file-relative-name (file-truename filename)
(oref obj reference-directory))
See the file semantic/scope.el for an example."
:abstract t)
-(defmethod semanticdb-cache-get ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-cache-get ((table semanticdb-abstract-table)
desired-class)
"Get a cache object on TABLE of class DESIRED-CLASS.
This method will create one if none exists with no init arguments
(object-add-to-list table 'cache obj)
obj)))
-(defmethod semanticdb-cache-remove ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-cache-remove ((table semanticdb-abstract-table)
cache)
"Remove from TABLE the cache object CACHE."
(object-remove-from-list table 'cache cache))
-(defmethod semanticdb-synchronize ((cache semanticdb-abstract-cache)
+(cl-defmethod semanticdb-synchronize ((cache semanticdb-abstract-cache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
;; The abstract class will do... NOTHING!
)
-(defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-cache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-cache)
new-tags)
"Synchronize a CACHE with some changed NEW-TAGS."
;; The abstract class will do... NOTHING!
See the file semantic/scope.el for an example."
:abstract t)
-(defmethod semanticdb-cache-get ((db semanticdb-project-database)
+(cl-defmethod semanticdb-cache-get ((db semanticdb-project-database)
desired-class)
"Get a cache object on DB of class DESIRED-CLASS.
This method will create one if none exists with no init arguments
(object-add-to-list db 'cache obj)
obj)))
-(defmethod semanticdb-cache-remove ((db semanticdb-project-database)
+(cl-defmethod semanticdb-cache-remove ((db semanticdb-project-database)
cache)
"Remove from TABLE the cache object CACHE."
(object-remove-from-list db 'cache cache))
-(defmethod semanticdb-synchronize ((cache semanticdb-abstract-db-cache)
+(cl-defmethod semanticdb-synchronize ((cache semanticdb-abstract-db-cache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
;; The abstract class will do... NOTHING!
)
-(defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-db-cache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-db-cache)
new-tags)
"Synchronize a CACHE with some changed NEW-TAGS."
;; The abstract class will do... NOTHING!
;;; REFRESH
-(defmethod semanticdb-refresh-table ((obj semanticdb-table) &optional force)
+(cl-defmethod semanticdb-refresh-table ((obj semanticdb-table) &optional force)
"If the tag list associated with OBJ is loaded, refresh it.
Optional argument FORCE will force a refresh even if the file in question
is not in a buffer. Avoid using FORCE for most uses, as an old cache
;; Kill off the buffer if it didn't exist when we were called.
(kill-buffer buff))))))
-(defmethod semanticdb-needs-refresh-p ((obj semanticdb-table))
+(cl-defmethod semanticdb-needs-refresh-p ((obj semanticdb-table))
"Return non-nil of OBJ's tag list is out of date.
The file associated with OBJ does not need to be in a buffer."
(let* ((ff (semanticdb-full-filename obj))
\f
;;; Synchronization
;;
-(defmethod semanticdb-synchronize ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-synchronize ((table semanticdb-abstract-table)
new-tags)
"Synchronize the table TABLE with some NEW-TAGS."
(oset table tags new-tags)
(semanticdb-refresh-references table)
)
-(defmethod semanticdb-partial-synchronize ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-partial-synchronize ((table semanticdb-abstract-table)
new-tags)
"Synchronize the table TABLE where some NEW-TAGS changed."
;; You might think we need to reset the tags, but since the partial
;;; SAVE/LOAD
;;
-(defmethod semanticdb-save-db ((DB semanticdb-project-database)
+(cl-defmethod semanticdb-save-db ((DB semanticdb-project-database)
&optional suppress-questions)
"Cause a database to save itself.
The database base class does not save itself persistently.
predicates with `add-hook' to this variable, and semanticdb will save tag
caches in directories controlled by them.")
-(defmethod semanticdb-write-directory-p ((obj semanticdb-project-database))
+(cl-defmethod semanticdb-write-directory-p ((obj semanticdb-project-database))
"Return non-nil if OBJ should be written to disk.
Uses `semanticdb-persistent-path' to determine the return value."
nil)
,@body))
(put 'semanticdb-with-match-any-mode 'lisp-indent-function 0)
-(defmethod semanticdb-equivalent-mode-for-search (table &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode-for-search (table &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
See `semanticdb-equivalent-mode' for details.
This version is used during searches. Major-modes that opt
(semanticdb-equivalent-mode table buffer))
)
-(defmethod semanticdb-equivalent-mode ((table semanticdb-abstract-table) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-abstract-table) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
nil)
-(defmethod semanticdb-equivalent-mode ((table semanticdb-table) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
(eval-when-compile (require 'cl))
(require 'semantic)
(require 'eieio)
+(require 'cl-generic)
(eval-when-compile (require 'semantic/find))
;;; Code:
"Controls action when in `semantic-debug-mode'")
;; Methods
-(defmethod semantic-debug-set-frame ((iface semantic-debug-interface) frame)
+(cl-defmethod semantic-debug-set-frame ((iface semantic-debug-interface) frame)
"Set the current frame on IFACE to FRAME."
(if frame
(oset iface current-frame frame)
(slot-makeunbound iface 'current-frame)))
-(defmethod semantic-debug-set-parser-location ((iface semantic-debug-interface) point)
+(cl-defmethod semantic-debug-set-parser-location ((iface semantic-debug-interface) point)
"Set the parser location in IFACE to POINT."
(with-current-buffer (oref iface parser-buffer)
(if (not (slot-boundp iface 'parser-location))
(move-marker (oref iface parser-location) point))
)
-(defmethod semantic-debug-set-source-location ((iface semantic-debug-interface) point)
+(cl-defmethod semantic-debug-set-source-location ((iface semantic-debug-interface) point)
"Set the source location in IFACE to POINT."
(with-current-buffer (oref iface source-buffer)
(if (not (slot-boundp iface 'source-location))
(move-marker (oref iface source-location) point))
)
-(defmethod semantic-debug-interface-layout ((iface semantic-debug-interface))
+(cl-defmethod semantic-debug-interface-layout ((iface semantic-debug-interface))
"Layout windows in the current frame to facilitate debugging."
(delete-other-windows)
;; Deal with the data buffer
(goto-char (oref iface source-location)))
)
-(defmethod semantic-debug-highlight-lexical-token ((iface semantic-debug-interface) token)
+(cl-defmethod semantic-debug-highlight-lexical-token ((iface semantic-debug-interface) token)
"For IFACE, highlight TOKEN in the source buffer .
TOKEN is a lexical token."
(set-buffer (oref iface :source-buffer))
(semantic-debug-set-source-location iface (semantic-lex-token-start token))
)
-(defmethod semantic-debug-highlight-rule ((iface semantic-debug-interface) nonterm &optional rule match)
+(cl-defmethod semantic-debug-highlight-rule ((iface semantic-debug-interface) nonterm &optional rule match)
"For IFACE, highlight NONTERM in the parser buffer.
NONTERM is the name of the rule currently being processed that shows up
as a nonterminal (or tag) in the source buffer.
))))
-(defmethod semantic-debug-unhighlight ((iface semantic-debug-interface))
+(cl-defmethod semantic-debug-unhighlight ((iface semantic-debug-interface))
"Remove all debugging overlays."
(mapc 'semantic-overlay-delete (oref iface overlays))
(oset iface overlays nil))
)
"One frame representation.")
-(defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
+(cl-defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
"Highlight one parser frame."
)
-(defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
+(cl-defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
"Display info about this one parser frame."
)
down to your parser later."
:abstract t)
-(defmethod semantic-debug-parser-next ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-next ((parser semantic-debug-parser))
"Execute next for this PARSER."
(setq semantic-debug-user-command 'next)
)
-(defmethod semantic-debug-parser-step ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-step ((parser semantic-debug-parser))
"Execute a step for this PARSER."
(setq semantic-debug-user-command 'step)
)
-(defmethod semantic-debug-parser-go ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-go ((parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'go)
)
-(defmethod semantic-debug-parser-fail ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-fail ((parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'fail)
)
-(defmethod semantic-debug-parser-quit ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-quit ((parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'quit)
)
-(defmethod semantic-debug-parser-abort ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-abort ((parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'abort)
)
-(defmethod semantic-debug-parser-print-state ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-print-state ((parser semantic-debug-parser))
"Print state for this PARSER at the current breakpoint."
(with-slots (current-frame) semantic-debug-current-interface
(when current-frame
(semantic-debug-frame-info current-frame)
)))
-(defmethod semantic-debug-parser-break ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-break ((parser semantic-debug-parser))
"Set a breakpoint for this PARSER."
)
;; Stack stuff
-(defmethod semantic-debug-parser-frames ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-frames ((parser semantic-debug-parser))
"Return a list of frames for the current parser.
A frame is of the form:
( .. .what ? .. )
any decorated referring includes.")
-(defmethod semantic-reset ((obj semantic-decoration-unparsed-include-cache))
+(cl-defmethod semantic-reset ((obj semantic-decoration-unparsed-include-cache))
"Reset OBJ back to it's empty settings."
(let ((table (oref obj table)))
;; This is a hack. Add in something better?
))
))
-(defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache)
new-tags)
"Synchronize CACHE with some NEW-TAGS."
(if (semantic-find-tags-by-class 'include new-tags)
(semantic-reset cache)))
-(defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
+(cl-defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))
doctmp
;; Check just before the definition.
(when (semantic-tag-with-position-p tag)
- (semantic-documentation-comment-preceeding-tag tag nosnarf))
+ (semantic-documentation-comment-preceding-tag tag nosnarf))
;; Let's look for comments either after the definition, but before code:
;; Not sure yet. Fill in something clever later....
nil))))))
-;; FIXME this is not how you spell "preceding".
-(defun semantic-documentation-comment-preceeding-tag (&optional tag nosnarf)
+(defun semantic-documentation-comment-preceding-tag (&optional tag nosnarf)
"Find a comment preceding TAG.
If TAG is nil. use the tag under point.
Searches the space between TAG and the preceding tag for a comment,
;; of a function.
(semantic-doc-snarf-comment-for-tag nosnarf)))
))
+(define-obsolete-function-alias
+ 'semantic-documentation-comment-preceeding-tag
+ 'semantic-documentation-comment-preceding-tag
+ "25.1")
(defun semantic-doc-snarf-comment-for-tag (nosnarf)
"Snarf up the comment at POINT for `semantic-documentation-for-tag'.
A grammar target consists of grammar files that build Emacs Lisp programs for
parsing different languages.")
-(defmethod ede-proj-makefile-dependencies ((this semantic-ede-proj-target-grammar))
+(cl-defmethod ede-proj-makefile-dependencies ((this semantic-ede-proj-target-grammar))
"Return a string representing the dependencies for THIS.
Some compilers only use the first element in the dependencies, others
have a list of intermediates (object files), and others don't care.
"Compile Emacs Lisp programs.")
;;; Target options.
-(defmethod ede-buffer-mine ((this semantic-ede-proj-target-grammar) buffer)
+(cl-defmethod ede-buffer-mine ((this semantic-ede-proj-target-grammar) buffer)
"Return t if object THIS lays claim to the file in BUFFER.
Lays claim to all -by.el, and -wy.el files."
;; We need to be a little more careful than this, but at the moment it
;; is common to have only one target of this class per directory.
(if (string-match "-[bw]y\\.elc?$" (buffer-file-name buffer))
t
- (call-next-method) ; The usual thing.
+ (cl-call-next-method) ; The usual thing.
))
-(defmethod project-compile-target ((obj semantic-ede-proj-target-grammar))
+(cl-defmethod project-compile-target ((obj semantic-ede-proj-target-grammar))
"Compile all sources in a Lisp target OBJ."
(let* ((cb (current-buffer))
(proj (ede-target-parent obj))
;;; Makefile generation functions
;;
-(defmethod ede-proj-makefile-sourcevar ((this semantic-ede-proj-target-grammar))
+(cl-defmethod ede-proj-makefile-sourcevar ((this semantic-ede-proj-target-grammar))
"Return the variable name for THIS's sources."
(cond ((ede-proj-automake-p)
(error "No Automake support for Semantic Grammars"))
(t (concat (ede-pmake-varname this) "_SEMANTIC_GRAMMAR"))))
-(defmethod ede-proj-makefile-insert-variables :AFTER ((this semantic-ede-proj-target-grammar))
+(cl-defmethod ede-proj-makefile-insert-variables :after ((this semantic-ede-proj-target-grammar))
"Insert variables needed by target THIS."
(ede-proj-makefile-insert-loadpath-items
(ede-proj-elisp-packages-to-loadpath
" ")))
)
-(defmethod ede-proj-makefile-insert-rules :after ((this semantic-ede-proj-target-grammar))
+(cl-defmethod ede-proj-makefile-insert-rules :after ((this semantic-ede-proj-target-grammar))
"Insert rules needed by THIS target.
This raises `max-specpdl-size' and `max-lisp-eval-depth', which can be
needed for the compilation of the resulting parsers."
max-lisp-eval-depth 700)'\n"
(oref this name))))
-(defmethod ede-proj-makefile-insert-dist-dependencies ((this semantic-ede-proj-target-grammar))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this semantic-ede-proj-target-grammar))
"Insert dist dependencies, or intermediate targets.
This makes sure that all grammar lisp files are created before the dist
runs, so they are always up to date.
Argument THIS is the target that should insert stuff."
- (call-next-method)
+ (cl-call-next-method)
(insert " $(" (ede-pmake-varname this) "_SEMANTIC_GRAMMAR_EL)")
)
)))
-(defmethod semantic-ia-sb-show-doc ((context semantic-analyze-context))
+(cl-defmethod semantic-ia-sb-show-doc ((context semantic-analyze-context))
"Show documentation about CONTEXT if CONTEXT points at a complete symbol."
(let ((sym (car (reverse (oref context prefix))))
(doc nil))
;; This is from semantic-sb
'semantic-sb-token-jump))))
-(defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context))
+(cl-defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context))
"Show a set of speedbar buttons specific to CONTEXT."
(let ((prefix (oref context prefix)))
(when prefix
'semantic-sb-token-jump))
))
-(defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-assignment))
+(cl-defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-assignment))
"Show a set of speedbar buttons specific to CONTEXT."
- (call-next-method)
+ (cl-call-next-method)
(let ((assignee (oref context assignee)))
(when assignee
(speedbar-insert-separator "Assignee")
'speedbar-tag-face
'semantic-sb-token-jump))))
-(defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-functionarg))
+(cl-defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-functionarg))
"Show a set of speedbar buttons specific to CONTEXT."
- (call-next-method)
+ (cl-call-next-method)
(let ((func (oref context function)))
(when func
(speedbar-insert-separator "Function")
)
"A single bookmark.")
-(defmethod initialize-instance :AFTER ((sbm semantic-bookmark) &rest fields)
+(cl-defmethod initialize-instance :after ((sbm semantic-bookmark) &rest fields)
"Initialize the bookmark SBM with details about :tag."
(condition-case nil
(save-excursion
(error (message "Error bookmarking tag.")))
)
-(defmethod semantic-mrub-visit ((sbm semantic-bookmark))
+(cl-defmethod semantic-mrub-visit ((sbm semantic-bookmark))
"Visit the semantic tag bookmark SBM.
Uses `semantic-go-to-tag' and highlighting."
(require 'semantic/decorate)
(semantic-momentary-highlight-tag tag)
))
-(defmethod semantic-mrub-update ((sbm semantic-bookmark) point reason)
+(cl-defmethod semantic-mrub-update ((sbm semantic-bookmark) point reason)
"Update the existing bookmark SBM.
POINT is some important location.
REASON is a symbol. See slot `reason' on `semantic-bookmark'."
(error nil))
)
-(defmethod semantic-mrub-preflush ((sbm semantic-bookmark))
+(cl-defmethod semantic-mrub-preflush ((sbm semantic-bookmark))
"Method called on a tag before the current buffer list of tags is flushed.
If there is a buffer match, unlink the tag."
(let ((tag (oref sbm tag))
(when nearby (setq tag nearby))))
tag))
-(defmethod semantic-mrub-push ((sbr semantic-bookmark-ring) point
+(cl-defmethod semantic-mrub-push ((sbr semantic-bookmark-ring) point
&optional reason)
"Add a bookmark to the ring SBR from POINT.
REASON is why it is being pushed. See doc for `semantic-bookmark'
;;
;; Methods for basic management of the structure in semanticdb.
;;
-(defmethod semantic-reset ((obj semantic-scope-cache))
+(cl-defmethod semantic-reset ((obj semantic-scope-cache))
"Reset OBJ back to it's empty settings."
(oset obj tag nil)
(oset obj scopetypes nil)
(oset obj typescope nil)
)
-(defmethod semanticdb-synchronize ((cache semantic-scope-cache)
+(cl-defmethod semanticdb-synchronize ((cache semantic-scope-cache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))
-(defmethod semanticdb-partial-synchronize ((cache semantic-scope-cache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semantic-scope-cache)
new-tags)
"Synchronize a CACHE with some changed NEW-TAGS."
;; If there are any includes or datatypes changed, then clear.
'semantic-scope-cache)))
(semantic-reset co))))
-(defmethod semantic-scope-set-typecache ((cache semantic-scope-cache)
+(cl-defmethod semantic-scope-set-typecache ((cache semantic-scope-cache)
types-in-scope)
"Set the :typescope property on CACHE to some types.
TYPES-IN-SCOPE is a list of type tags whos members are
;;; DUMP
;;
-(defmethod semantic-analyze-show ((context semantic-scope-cache))
+(cl-defmethod semantic-analyze-show ((context semantic-scope-cache))
"Insert CONTEXT into the current buffer in a nice way."
(require 'semantic/analyze)
(semantic-analyze-princ-sequence (oref context scopetypes) "-> ScopeTypes: " )
)
"The results from a symbol reference search.")
-(defmethod semantic-symref-result-get-files ((result semantic-symref-result))
+(cl-defmethod semantic-symref-result-get-files ((result semantic-symref-result))
"Get the list of files from the symref result RESULT."
(if (slot-boundp result :hit-files)
(oref result hit-files)
(remove-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn)
)
-(defmethod semantic-symref-result-get-tags ((result semantic-symref-result)
+(cl-defmethod semantic-symref-result-get-tags ((result semantic-symref-result)
&optional open-buffers)
"Get the list of tags from the symref result RESULT.
Optional OPEN-BUFFERS indicates that the buffers that the hits are
`semantic-symref-tool'"
:abstract t)
-(defmethod semantic-symref-get-result ((tool semantic-symref-tool-baseclass))
+(cl-defmethod semantic-symref-get-result ((tool semantic-symref-tool-baseclass))
"Calculate the results of a search based on TOOL.
The symref TOOL should already contain the search criteria."
(let ((answer (semantic-symref-perform-search tool))
)
))
-(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-baseclass))
+(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-baseclass))
"Base search for symref tools should throw an error."
(error "Symref tool objects must implement `semantic-symref-perform-search'"))
-(defmethod semantic-symref-parse-tool-output ((tool semantic-symref-tool-baseclass)
+(cl-defmethod semantic-symref-parse-tool-output ((tool semantic-symref-tool-baseclass)
outputbuffer)
"Parse the entire OUTPUTBUFFER of a symref tool.
Calls the method `semantic-symref-parse-tool-output-one-line' over and
(nreverse result)))
)
-(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-baseclass))
+(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-baseclass))
"Base tool output parser is not implemented."
(error "Symref tool objects must implement `semantic-symref-parse-tool-output-one-line'"))
See the function `cedet-cscope-search' for more details.")
-(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-cscope))
+(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-cscope))
"Perform a search with GNU Global."
(let* ((rootproj (when (and (featurep 'ede) ede-minor-mode)
(ede-toplevel)))
(semantic-symref-parse-tool-output tool b)
))
-(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-cscope))
+(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-cscope))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file)
See the function `cedet-gnu-global-search' for more details.")
-(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-global))
+(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-global))
"Perform a search with GNU Global."
(let ((b (cedet-gnu-global-search (oref tool :searchfor)
(oref tool :searchtype)
(semantic-symref-parse-tool-output tool b)
))
-(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-global))
+(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-global))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
(cond ((or (eq (oref tool :resulttype) 'file)
:group 'semantic
:type 'string)
-(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-grep))
+(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-grep))
"Perform a search with Grep."
;; Grep doesn't support some types of searches.
(let ((st (oref tool :searchtype)))
;; Return the answer
ans))
-(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-grep))
+(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-grep))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file)
See the function `cedet-idutils-search' for more details.")
-(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-idutils))
+(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-idutils))
"Perform a search with IDUtils."
(let ((b (cedet-idutils-search (oref tool :searchfor)
(oref tool :searchtype)
(semantic-symref-parse-tool-output tool b)
))
-(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-idutils))
+(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-idutils))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file)
(eval-when-compile (require 'cl))
(require 'semantic)
(require 'eieio)
+(require 'cl-generic)
(require 'eieio-base)
(require 'srecode/table)
(require 'srecode/dictionary)
Plain text strings are not handled via this baseclass."
:abstract t)
-(defmethod srecode-parse-input ((ins srecode-template-inserter)
+(cl-defmethod srecode-parse-input ((ins srecode-template-inserter)
tag input STATE)
"For the template inserter INS, parse INPUT.
Shorten input only by the amount needed.
STATE is the current compilation state."
input)
-(defmethod srecode-match-end ((ins srecode-template-inserter) name)
+(cl-defmethod srecode-match-end ((ins srecode-template-inserter) name)
"For the template inserter INS, do I end a section called NAME?"
nil)
-(defmethod srecode-inserter-apply-state ((ins srecode-template-inserter) STATE)
+(cl-defmethod srecode-inserter-apply-state ((ins srecode-template-inserter) STATE)
"For the template inserter INS, apply information from STATE."
nil)
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter)
+(cl-defmethod srecode-inserter-prin-example ((ins (subclass srecode-template-inserter))
escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
)
"Current state of the compile.")
-(defmethod srecode-compile-add-prompt ((state srecode-compile-state)
+(cl-defmethod srecode-compile-add-prompt ((state srecode-compile-state)
prompttag)
"Add PROMPTTAG to the current list of prompts."
(with-slots (prompts) state
;; Dump out information about the current srecoder compiled templates.
;;
-(defmethod srecode-dump ((tmp srecode-template))
+(cl-defmethod srecode-dump ((tmp srecode-template))
"Dump the contents of the SRecode template tmp."
(princ "== Template \"")
(princ (eieio-object-name-string tmp))
(princ "\n"))))
)
-(defmethod srecode-dump ((ins srecode-template-inserter) indent)
+(cl-defmethod srecode-dump ((ins srecode-template-inserter) indent)
"Dump the state of the SRecode template inserter INS."
(princ "INS: \"")
(princ (eieio-object-name-string ins))
(eval-when-compile (require 'cl))
(require 'eieio)
+(require 'cl-generic)
(require 'srecode)
(require 'srecode/table)
(eval-when-compile (require 'semantic))
with appending various parts together in a list.")
-(defmethod initialize-instance ((this srecode-dictionary-compound-variable)
+(cl-defmethod initialize-instance ((this srecode-dictionary-compound-variable)
&optional fields)
"Initialize the compound variable THIS.
Makes sure that :value is compiled."
;;(when (not state)
;; (error "Cannot create compound variable outside of sectiondictionary"))
- (call-next-method this (nreverse newfields))
+ (cl-call-next-method this (nreverse newfields))
(when (not (slot-boundp this 'compiled))
(let ((val (oref this :value))
(comp nil))
))
dict))))
-(defmethod srecode-dictionary-add-template-table ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-add-template-table ((dict srecode-dictionary)
tpl)
"Insert into DICT the variables found in table TPL.
TPL is an object representing a compiled template file."
(setq tabs (cdr tabs))))))
-(defmethod srecode-dictionary-set-value ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-set-value ((dict srecode-dictionary)
name value)
"In dictionary DICT, set NAME to have VALUE."
;; Validate inputs
(puthash name value namehash))
)
-(defmethod srecode-dictionary-add-section-dictionary ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-add-section-dictionary ((dict srecode-dictionary)
name &optional show-only force)
"In dictionary DICT, add a section dictionary for section macro NAME.
Return the new dictionary.
;; Return the new sub-dictionary.
new))
-(defmethod srecode-dictionary-show-section ((dict srecode-dictionary) name)
+(cl-defmethod srecode-dictionary-show-section ((dict srecode-dictionary) name)
"In dictionary DICT, indicate that the section NAME should be exposed."
;; Validate inputs
(unless (stringp name)
(srecode-dictionary-add-section-dictionary dict name t)
nil)
-(defmethod srecode-dictionary-hide-section ((dict srecode-dictionary) name)
+(cl-defmethod srecode-dictionary-hide-section ((dict srecode-dictionary) name)
"In dictionary DICT, indicate that the section NAME should be hidden."
;; We need to find the has value, and then delete it.
;; Validate inputs
(remhash name namehash))
nil)
-(defmethod srecode-dictionary-add-entries ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-add-entries ((dict srecode-dictionary)
entries &optional state)
"Add ENTRIES to DICT.
(setq entries (nthcdr 2 entries)))
dict)
-(defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict
+(cl-defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict
&optional force)
"Merge into DICT the dictionary entries from OTHERDICT.
Unless the optional argument FORCE is non-nil, values in DICT are
(srecode-dictionary-set-value dict key entry)))))
(oref otherdict namehash))))
-(defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary)
name &optional non-recursive)
"Return information about DICT's value for NAME.
DICT is a dictionary, and NAME is a string that is treated as the
(srecode-dictionary-lookup-name parent name)))))
)
-(defmethod srecode-root-dictionary ((dict srecode-dictionary))
+(cl-defmethod srecode-root-dictionary ((dict srecode-dictionary))
"For dictionary DICT, return the root dictionary.
The root dictionary is usually for a current or active insertion."
(let ((ans dict))
;; Compound values must provide at least the toString method
;; for use in converting the compound value into something insertable.
-(defmethod srecode-compound-toString ((cp srecode-dictionary-compound-value)
+(cl-defmethod srecode-compound-toString ((cp srecode-dictionary-compound-value)
function
dictionary)
"Convert the compound dictionary value CP to a string.
standard out is a buffer, and using `insert'."
(eieio-object-name cp))
-(defmethod srecode-dump ((cp srecode-dictionary-compound-value)
+(cl-defmethod srecode-dump ((cp srecode-dictionary-compound-value)
&optional indent)
"Display information about this compound value."
(princ (eieio-object-name cp))
)
-(defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable)
+(cl-defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable)
function
dictionary)
"Convert the compound dictionary variable value CP into a string.
(srecode-insert-code-stream (oref cp compiled) dictionary))
-(defmethod srecode-dump ((cp srecode-dictionary-compound-variable)
+(cl-defmethod srecode-dump ((cp srecode-dictionary-compound-variable)
&optional indent)
"Display information about this compound value."
(require 'srecode/compile)
it is referenced a second time. This compound value can then be
inserted with a new editable field.")
-(defmethod srecode-compound-toString((cp srecode-field-value)
+(cl-defmethod srecode-compound-toString((cp srecode-field-value)
function
dictionary)
"Convert this field into an insertable string."
(srecode-dump dict))
))))
-(defmethod srecode-dump ((dict srecode-dictionary) &optional indent)
+(cl-defmethod srecode-dump ((dict srecode-dictionary) &optional indent)
"Dump a dictionary."
(if (not indent) (setq indent 0))
(maphash (lambda (key entry)
(beginning-of-line)
(forward-char -1)
- (let ((lextok (semantic-documentation-comment-preceeding-tag fcn-in 'lex))
+ (let ((lextok (semantic-documentation-comment-preceding-tag fcn-in 'lex))
(doctext
(srecode-document-function-name-comment fcn-in))
)
)
"The current extraction state.")
-(defmethod srecode-extract-state-set ((st srecode-extract-state) ins dict)
+(cl-defmethod srecode-extract-state-set ((st srecode-extract-state) ins dict)
"Set onto the extract state ST a new inserter INS and dictionary DICT."
(oset st lastinserter ins)
(oset st lastdict dict))
-(defmethod srecode-extract-state-set-anchor ((st srecode-extract-state))
+(cl-defmethod srecode-extract-state-set-anchor ((st srecode-extract-state))
"Reset the anchor point on extract state ST."
(oset st anchor (point)))
-(defmethod srecode-extract-state-extract ((st srecode-extract-state)
+(cl-defmethod srecode-extract-state-extract ((st srecode-extract-state)
endpoint)
"Perform an extraction on the extract state ST with ENDPOINT.
If there was no waiting inserter, do nothing."
(srecode-extract-method template dict state)
dict))))
-(defmethod srecode-extract-method ((st srecode-template) dictionary
+(cl-defmethod srecode-extract-method ((st srecode-template) dictionary
state)
"Extract template ST and store extracted text in DICTIONARY.
Optional STARTRETURN is a symbol in which the start of the first
;;; Inserter Base Extractors
;;
-(defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter))
+(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter))
"Return non-nil if this inserter can extract values."
nil)
-(defmethod srecode-inserter-extract ((ins srecode-template-inserter)
+(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter)
start end dict state)
"Extract text from START/END and store in DICT.
Return nil as this inserter will extract nothing."
;;; Variable extractor is simple and can extract later.
;;
-(defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-variable))
+(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-variable))
"Return non-nil if this inserter can extract values."
'later)
-(defmethod srecode-inserter-extract ((ins srecode-template-inserter-variable)
+(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-variable)
start end vdict state)
"Extract text from START/END and store in VDICT.
Return t if something was extracted.
;;; Section Inserter
;;
-(defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-section-start))
+(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-section-start))
"Return non-nil if this inserter can extract values."
'now)
-(defmethod srecode-inserter-extract ((ins srecode-template-inserter-section-start)
+(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-section-start)
start end indict state)
"Extract text from START/END and store in INDICT.
Return the starting location of the first plain-text match.
;;; Include Extractor must extract now.
;;
-(defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-include))
+(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-include))
"Return non-nil if this inserter can extract values."
'now)
-(defmethod srecode-inserter-extract ((ins srecode-template-inserter-include)
+(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-include)
start end dict state)
"Extract text from START/END and store in DICT.
Return the starting location of the first plain-text match.
;; Keep this library independent of SRecode proper.
(require 'eieio)
+(require 'cl-generic)
;;; Code:
(defvar srecode-field-archive nil
"An object that gets automatically bound to an overlay.
Has virtual :start and :end initializers.")
-(defmethod initialize-instance ((olaid srecode-overlaid) &optional args)
+(cl-defmethod initialize-instance ((olaid srecode-overlaid) &optional args)
"Initialize OLAID, being sure it archived."
;; Extract :start and :end from the olaid list.
(let ((newargs nil)
(overlay-put olay 'srecode-init-only t)
(oset olaid overlay olay)
- (call-next-method olaid (nreverse newargs))
+ (cl-call-next-method olaid (nreverse newargs))
))
-(defmethod srecode-overlaid-activate ((olaid srecode-overlaid))
+(cl-defmethod srecode-overlaid-activate ((olaid srecode-overlaid))
"Activate the overlaid area."
(let* ((ola (oref olaid overlay))
(start (overlay-start ola))
))
-(defmethod srecode-delete ((olaid srecode-overlaid))
+(cl-defmethod srecode-delete ((olaid srecode-overlaid))
"Delete the overlay from OLAID."
(delete-overlay (oref olaid overlay))
(slot-makeunbound olaid 'overlay)
)
-(defmethod srecode-empty-region-p ((olaid srecode-overlaid))
+(cl-defmethod srecode-empty-region-p ((olaid srecode-overlaid))
"Return non-nil if the region covered by OLAID is of length 0."
(= 0 (srecode-region-size olaid)))
-(defmethod srecode-region-size ((olaid srecode-overlaid))
+(cl-defmethod srecode-region-size ((olaid srecode-overlaid))
"Return the length of region covered by OLAID."
(let ((start (overlay-start (oref olaid overlay)))
(end (overlay-end (oref olaid overlay))))
(- end start)))
-(defmethod srecode-point-in-region-p ((olaid srecode-overlaid))
+(cl-defmethod srecode-point-in-region-p ((olaid srecode-overlaid))
"Return non-nil if point is in the region of OLAID."
(let ((start (overlay-start (oref olaid overlay)))
(end (overlay-end (oref olaid overlay))))
(setq ol (cdr ol)))
(car (nreverse ret))))
-(defmethod srecode-overlaid-text ((olaid srecode-overlaid) &optional set-to)
+(cl-defmethod srecode-overlaid-text ((olaid srecode-overlaid) &optional set-to)
"Return the text under OLAID.
If SET-TO is a string, then replace the text of OLAID wit SET-TO."
(let* ((ol (oref olaid overlay))
)
"Manage a buffer region in which fields exist.")
-(defmethod initialize-instance ((ir srecode-template-inserted-region)
+(cl-defmethod initialize-instance ((ir srecode-template-inserted-region)
&rest args)
"Initialize IR, capturing the active fields, and creating the overlay."
;; Fill in the fields
(setq srecode-field-archive nil)
;; Initialize myself first.
- (call-next-method)
+ (cl-call-next-method)
)
-(defmethod srecode-overlaid-activate ((ir srecode-template-inserted-region))
+(cl-defmethod srecode-overlaid-activate ((ir srecode-template-inserted-region))
"Activate the template area for IR."
;; Activate all our fields
(srecode-overlaid-activate F))
;; Activate our overlay.
- (call-next-method)
+ (cl-call-next-method)
;; Position the cursor at the first field
(let ((first (car (oref ir fields))))
(add-hook 'post-command-hook 'srecode-field-post-command t t)
)
-(defmethod srecode-delete ((ir srecode-template-inserted-region))
+(cl-defmethod srecode-delete ((ir srecode-template-inserted-region))
"Call into our base, but also clear out the fields."
;; Clear us out of the baseclass.
(oset ir active-region nil)
;; Clear our fields.
(mapc 'srecode-delete (oref ir fields))
;; Call to our base
- (call-next-method)
+ (cl-call-next-method)
;; Clear our hook.
(remove-hook 'post-command-hook 'srecode-field-post-command t)
)
km)
"Keymap applied to field overlays.")
-(defmethod initialize-instance ((field srecode-field) &optional args)
+(cl-defmethod initialize-instance ((field srecode-field) &optional args)
"Initialize FIELD, being sure it archived."
(add-to-list 'srecode-field-archive field t)
- (call-next-method)
+ (cl-call-next-method)
)
-(defmethod srecode-overlaid-activate ((field srecode-field))
+(cl-defmethod srecode-overlaid-activate ((field srecode-field))
"Activate the FIELD area."
- (call-next-method)
+ (cl-call-next-method)
(let* ((ol (oref field overlay))
(end nil)
)
)
-(defmethod srecode-delete ((olaid srecode-field))
+(cl-defmethod srecode-delete ((olaid srecode-field))
"Delete our secondary overlay."
;; Remove our spare overlay
(delete-overlay (oref olaid tail))
(slot-makeunbound olaid 'tail)
;; Do our baseclass work.
- (call-next-method)
+ (cl-call-next-method)
)
(defvar srecode-field-replication-max-size 100
(srecode-field-mod-hook ol after start end pre-len))
))
-(defmethod srecode-field-goto ((field srecode-field))
+(cl-defmethod srecode-field-goto ((field srecode-field))
"Goto the FIELD."
(goto-char (overlay-start (oref field overlay))))
;;
;; Find if a template table has a project set, and if so, is the
;; current buffer in that project.
-(defmethod srecode-template-table-in-project-p ((tab srecode-template-table))
+(cl-defmethod srecode-template-table-in-project-p ((tab srecode-template-table))
"Return non-nil if the table TAB can be used in the current project.
If TAB has a :project set, check that the directories match.
If TAB is nil, then always return t."
;;
;; Find a given template based on name, and features of the current
;; buffer.
-(defmethod srecode-template-get-table ((tab srecode-template-table)
+(cl-defmethod srecode-template-get-table ((tab srecode-template-table)
template-name &optional
context application)
"Find in the template in table TAB, the template with TEMPLATE-NAME.
;; No context, perhaps a merged name?
(gethash template-name (oref tab namehash)))))
-(defmethod srecode-template-get-table ((tab srecode-mode-table)
+(cl-defmethod srecode-template-get-table ((tab srecode-mode-table)
template-name &optional
context application)
"Find in the template in mode table TAB, the template with TEMPLATE-NAME.
;;
;; Find a given template based on a key binding.
;;
-(defmethod srecode-template-get-table-for-binding
+(cl-defmethod srecode-template-get-table-for-binding
((tab srecode-template-table) binding &optional context)
"Find in the template name in table TAB, the template with BINDING.
Optional argument CONTEXT specifies that the template should part
(maphash hashfcn (oref tab namehash)))
keyout)))
-(defmethod srecode-template-get-table-for-binding
+(cl-defmethod srecode-template-get-table-for-binding
((tab srecode-mode-table) binding &optional context application)
"Find in the template name in mode table TAB, the template with BINDING.
Optional argument CONTEXT specifies a context a particular template
;; Code managing the top-level insert method and the current
;; insertion stack.
;;
-(defmethod srecode-push ((st srecode-template))
+(cl-defmethod srecode-push ((st srecode-template))
"Push the srecoder template ST onto the active stack."
(oset st active (cons st (oref st active))))
-(defmethod srecode-pop :STATIC ((st srecode-template))
+(cl-defmethod srecode-pop ((st (subclass srecode-template)))
"Pop the srecoder template ST onto the active stack.
ST can be a class, or an object."
(oset st active (cdr (oref st active))))
-(defmethod srecode-peek :STATIC ((st srecode-template))
+(cl-defmethod srecode-peek ((st (subclass srecode-template)))
"Fetch the topmost active template record. ST can be a class."
(car (oref st active)))
-(defmethod srecode-insert-method ((st srecode-template) dictionary)
+(cl-defmethod srecode-insert-method ((st srecode-template) dictionary)
"Insert the srecoder template ST."
;; Merge any template entries into the input dictionary.
;; This may happen twice since some templates arguments need
Specify the :indent argument to enable automatic indentation when newlines
occur in your template.")
-(defmethod srecode-insert-method ((sti srecode-template-inserter-newline)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-newline)
dictionary)
"Insert the STI inserter."
;; To be safe, indent the previous line since the template will
((stringp i)
(princ i))))))
-(defmethod srecode-dump ((ins srecode-template-inserter-newline) indent)
+(cl-defmethod srecode-dump ((ins srecode-template-inserter-newline) indent)
"Dump the state of the SRecode template inserter INS."
- (call-next-method)
+ (cl-call-next-method)
(when (oref ins hard)
(princ " : hard")
))
"Insert a newline before and after a template, and possibly do indenting.
Specify the :blank argument to enable this inserter.")
-(defmethod srecode-insert-method ((sti srecode-template-inserter-blank)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-blank)
dictionary)
"Make sure there is no text before or after point."
(let ((i (srecode-dictionary-lookup-name dictionary "INDENT"))
)
"Allow comments within template coding. This inserts nothing.")
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-comment)
+(cl-defmethod srecode-inserter-prin-example ((ins (subclass srecode-template-inserter-comment))
escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-method ((sti srecode-template-inserter-comment)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-comment)
dictionary)
"Don't insert anything for comment macros in STI."
nil)
(defvar srecode-inserter-variable-current-dictionary nil
"The active dictionary when calling a variable filter.")
-(defmethod srecode-insert-variable-secondname-handler
+(cl-defmethod srecode-insert-variable-secondname-handler
((sti srecode-template-inserter-variable) dictionary value secondname)
"For VALUE handle SECONDNAME behaviors for this variable inserter.
Return the result as a string.
(object-print sti) secondname)))
value))
-(defmethod srecode-insert-method ((sti srecode-template-inserter-variable)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-variable)
dictionary)
"Insert the STI inserter."
;; Convert the name into a name/fcn pair
The prompt text used is derived from the previous PROMPT command in the
template file.")
-(defmethod srecode-inserter-apply-state
+(cl-defmethod srecode-inserter-apply-state
((ins srecode-template-inserter-ask) STATE)
"For the template inserter INS, apply information from STATE.
Loop over the prompts to see if we have a match."
(setq prompts (cdr prompts)))
))
-(defmethod srecode-insert-method ((sti srecode-template-inserter-ask)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-ask)
dictionary)
"Insert the STI inserter."
(let ((val (srecode-dictionary-lookup-name
dictionary (oref sti :object-name))))
(if val
;; Does some extra work. Oh well.
- (call-next-method)
+ (cl-call-next-method)
;; How is our -ask value determined?
(if srecode-insert-with-fields-in-progress
;; Now that this value is safely stowed in the dictionary,
;; we can do what regular inserters do.
- (call-next-method))))
+ (cl-call-next-method))))
-(defmethod srecode-insert-ask-default ((sti srecode-template-inserter-ask)
+(cl-defmethod srecode-insert-ask-default ((sti srecode-template-inserter-ask)
dictionary)
"Derive the default value for an askable inserter STI.
DICTIONARY is used to derive some values."
dictionary
"Unknown default for prompt: %S" defaultfcn)))))
-(defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask)
+(cl-defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask)
dictionary)
"Do the \"asking\" for the template inserter STI.
Use DICTIONARY to resolve values."
val)
)
-(defmethod srecode-insert-method-field ((sti srecode-template-inserter-ask)
+(cl-defmethod srecode-insert-method-field ((sti srecode-template-inserter-ask)
dictionary)
"Create an editable field for the template inserter STI.
Use DICTIONARY to resolve values."
;; across multiple locations.
compound-value))
-(defmethod srecode-dump ((ins srecode-template-inserter-ask) indent)
+(cl-defmethod srecode-dump ((ins srecode-template-inserter-ask) indent)
"Dump the state of the SRecode template inserter INS."
- (call-next-method)
+ (cl-call-next-method)
(princ " : \"")
(princ (oref ins prompt))
(princ "\"")
to 10 characters, with spaces added to the left. Use `right' for adding
spaces to the right.")
-(defmethod srecode-insert-variable-secondname-handler
+(cl-defmethod srecode-insert-variable-secondname-handler
((sti srecode-template-inserter-width) dictionary value width)
"For VALUE handle WIDTH behaviors for this variable inserter.
Return the result as a string.
(concat padchars value)
(concat value padchars))))))
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-width)
+(cl-defmethod srecode-inserter-prin-example ((ins (subclass srecode-template-inserter-width))
escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
Some inserter macros, such as `srecode-template-inserter-include-wrap'
will place text at the ^ macro from the included macro.")
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-point)
+(cl-defmethod srecode-inserter-prin-example ((ins (subclass srecode-template-inserter-point))
escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-method ((sti srecode-template-inserter-point)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-point)
dictionary)
"Insert the STI inserter.
Save point in the class allocated 'point' slot.
"Wrap a section of a template under the control of a macro."
:abstract t)
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-subtemplate)
+(cl-defmethod srecode-inserter-prin-example ((ins (subclass srecode-template-inserter-subtemplate))
escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
- (call-next-method)
+ (cl-call-next-method)
(princ " Template Text to control")
(terpri)
(princ " ")
(terpri)
)
-(defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate)
+(cl-defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate)
dict slot)
"Insert a subtemplate for the inserter STI with dictionary DICT."
;; Make sure that only dictionaries are used.
;; Output the code from the sub-template.
(srecode-insert-method (slot-value sti slot) dict))
-(defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate)
+(cl-defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate)
dictionary slot)
"Do the work for inserting the STI inserter.
Loops over the embedded CODE which was saved here during compilation.
(srecode-insert-subtemplate sti (car dicts) slot)
(setq dicts (cdr dicts)))))
-(defmethod srecode-insert-method ((sti srecode-template-inserter-subtemplate)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-subtemplate)
dictionary)
"Insert the STI inserter.
Calls back to `srecode-insert-method-helper' for this class."
applied to the text between the section start and the
`srecode-template-inserter-section-end' macro.")
-(defmethod srecode-parse-input ((ins srecode-template-inserter-section-start)
+(cl-defmethod srecode-parse-input ((ins srecode-template-inserter-section-start)
tag input STATE)
"For the section inserter INS, parse INPUT.
Shorten input until the END token is found.
:code (cdr out)))
(car out)))
-(defmethod srecode-dump ((ins srecode-template-inserter-section-start) indent)
+(cl-defmethod srecode-dump ((ins srecode-template-inserter-section-start) indent)
"Dump the state of the SRecode template inserter INS."
- (call-next-method)
+ (cl-call-next-method)
(princ "\n")
(srecode-dump-code-list (oref (oref ins template) code)
(concat indent " "))
"All template segments between the section-start and section-end
are treated specially.")
-(defmethod srecode-insert-method ((sti srecode-template-inserter-section-end)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-section-end)
dictionary)
"Insert the STI inserter."
)
-(defmethod srecode-match-end ((ins srecode-template-inserter-section-end) name)
+(cl-defmethod srecode-match-end ((ins srecode-template-inserter-section-end) name)
"For the template inserter INS, do I end a section called NAME?"
(string= name (oref ins :object-name)))
The included template will have additional dictionary entries from the subdictionary
stored specified by this macro.")
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-include)
+(cl-defmethod srecode-inserter-prin-example ((ins (subclass srecode-template-inserter-include))
escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-include-lookup ((sti srecode-template-inserter-include)
+(cl-defmethod srecode-insert-include-lookup ((sti srecode-template-inserter-include)
dictionary)
"For the template inserter STI, lookup the template to include.
Finds the template with this macro function part and stores it in
"No template \"%s\" found for include macro `%s'"
templatenamepart (oref sti :object-name)))))
-(defmethod srecode-insert-method ((sti srecode-template-inserter-include)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-include)
dictionary)
"Insert the STI inserter.
Finds the template with this macro function part, and inserts it
then the text between this macro and the end macro will be inserted at
the ^ macro.")
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-include-wrap)
+(cl-defmethod srecode-inserter-prin-example ((ins (subclass srecode-template-inserter-include-wrap))
escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-method ((sti srecode-template-inserter-include-wrap)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-include-wrap)
dictionary)
"Insert the template STI.
This will first insert the include part via inheritance, then
inserter1 dict 'template))))))))
;; Do a regular insertion for an include, but with our override in
;; place.
- (call-next-method)))
+ (cl-call-next-method)))
(provide 'srecode/insert)
)
"A map of srecode templates.")
-(defmethod srecode-map-entry-for-file ((map srecode-map) file)
+(cl-defmethod srecode-map-entry-for-file ((map srecode-map) file)
"Return the entry in MAP for FILE."
(assoc file (oref map files)))
-(defmethod srecode-map-entries-for-mode ((map srecode-map) mode)
+(cl-defmethod srecode-map-entries-for-mode ((map srecode-map) mode)
"Return the entries in MAP for major MODE."
(let ((ans nil))
(dolist (f (oref map files))
(setq ans (cons f ans))))
ans))
-(defmethod srecode-map-entry-for-app ((map srecode-map) app)
+(cl-defmethod srecode-map-entry-for-app ((map srecode-map) app)
"Return the entry in MAP for APP."
(assoc app (oref map apps))
)
-(defmethod srecode-map-entries-for-app-and-mode ((map srecode-map) app mode)
+(cl-defmethod srecode-map-entries-for-app-and-mode ((map srecode-map) app mode)
"Return the entries in MAP for major MODE."
(let ((ans nil)
(appentry (srecode-map-entry-for-app map app)))
(setq ans (cons f ans))))
ans))
-(defmethod srecode-map-entry-for-file-anywhere ((map srecode-map) file)
+(cl-defmethod srecode-map-entry-for-file-anywhere ((map srecode-map) file)
"Search in all entry points in MAP for FILE.
Return a list ( APP . FILE-ASSOC ) where APP is nil
in the global map."
;; Other?
))
-(defmethod srecode-map-delete-file-entry ((map srecode-map) file)
+(cl-defmethod srecode-map-delete-file-entry ((map srecode-map) file)
"Update MAP to exclude FILE from the file list."
(let ((entry (srecode-map-entry-for-file map file)))
(when entry
(object-remove-from-list map 'files entry))))
-(defmethod srecode-map-update-file-entry ((map srecode-map) file mode)
+(cl-defmethod srecode-map-update-file-entry ((map srecode-map) file mode)
"Update a MAP entry for FILE to be used with MODE.
Return non-nil if the MAP was changed."
(let ((entry (srecode-map-entry-for-file map file))
))
dirty))
-(defmethod srecode-map-delete-file-entry-from-app ((map srecode-map) file app)
+(cl-defmethod srecode-map-delete-file-entry-from-app ((map srecode-map) file app)
"Delete from MAP the FILE entry within the APP."
(let* ((appe (srecode-map-entry-for-app map app))
(fentry (assoc file (cdr appe))))
(setcdr appe (delete fentry (cdr appe))))
)
-(defmethod srecode-map-update-app-file-entry ((map srecode-map) file mode app)
+(cl-defmethod srecode-map-update-app-file-entry ((map srecode-map) file mode app)
"Update the MAP entry for FILE to be used with MODE within APP.
Return non-nil if the map was changed."
(let* ((appentry (srecode-map-entry-for-app map app))
"Wrap up a collection of semantic tag information.
This class will be used to derive dictionary values.")
-(defmethod srecode-compound-toString((cp srecode-semantic-tag)
+(cl-defmethod srecode-compound-toString((cp srecode-semantic-tag)
function
dictionary)
"Convert the compound dictionary value CP to a string.
;;
(require 'eieio)
+(require 'cl-generic)
(require 'eieio-base)
(require 'mode-local)
(require 'srecode)
new))))
-(defmethod srecode-mode-table-find ((mt srecode-mode-table) file)
+(cl-defmethod srecode-mode-table-find ((mt srecode-mode-table) file)
"Look in the mode table MT for a template table from FILE.
Return nil if there was none."
(object-assoc file 'file (oref mt modetables)))
(srecode-dump tmp))
)))
-(defmethod srecode-dump ((tab srecode-mode-table))
+(cl-defmethod srecode-dump ((tab srecode-mode-table))
"Dump the contents of the SRecode mode table TAB."
(princ "MODE TABLE FOR ")
(princ (oref tab :major-mode))
(setq subtab (cdr subtab)))
))
-(defmethod srecode-dump ((tab srecode-template-table))
+(cl-defmethod srecode-dump ((tab srecode-template-table))
"Dump the contents of the SRecode template table TAB."
(princ "Template Table for ")
(princ (eieio-object-name-string tab))
(define-key map "\C-c\C-\\" 'comint-quit-subjob)
(define-key map "\C-c\C-m" 'comint-copy-old-input)
(define-key map "\C-c\C-o" 'comint-delete-output)
+ (define-key map "\C-c\M-o" 'comint-clear-buffer)
(define-key map "\C-c\C-r" 'comint-show-output)
(define-key map "\C-c\C-e" 'comint-show-maximum-output)
(define-key map "\C-c\C-l" 'comint-dynamic-list-input-ring)
(or
;; 1. First try searching in the initial comint text
(funcall search-fun string
- (if isearch-forward bound (field-beginning))
+ (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
(when (null comint-input-ring-index)
(error "End of history; no next item"))
(comint-next-input 1)
- (goto-char (field-beginning)))
+ (goto-char (comint-line-beginning-position)))
(t
;; Signal an error here explicitly, because
;; `comint-previous-input' doesn't signal an error.
(unless isearch-forward
;; For backward search, don't search
;; in the comint prompt
- (field-beginning))
+ (comint-line-beginning-position))
noerror)))
;; Return point of the new search result
(point))
(if (overlayp comint-history-isearch-message-overlay)
(move-overlay comint-history-isearch-message-overlay
(save-excursion
- (goto-char (field-beginning))
+ (goto-char (comint-line-beginning-position))
(forward-line 0)
(point))
- (field-beginning))
+ (comint-line-beginning-position))
(setq comint-history-isearch-message-overlay
(make-overlay (save-excursion
- (goto-char (field-beginning))
+ (goto-char (comint-line-beginning-position))
(forward-line 0)
(point))
- (field-beginning)))
+ (comint-line-beginning-position)))
(overlay-put comint-history-isearch-message-overlay 'evaporate t))
(overlay-put comint-history-isearch-message-overlay
'display (isearch-message-prefix ellipsis isearch-nonincremental))
(comint-goto-input (1- (ring-length comint-input-ring)))
(comint-goto-input nil))
(setq isearch-success t)
- (goto-char (if isearch-forward (field-beginning) (point-max))))
+ (goto-char (if isearch-forward (comint-line-beginning-position) (point-max))))
(defun comint-history-isearch-push-state ()
"Save a function restoring the state of input history search.
(widen)
(let* ((pmark (process-mark proc))
(intxt (if (>= (point) (marker-position pmark))
- (progn (if comint-eol-on-send (goto-char (field-end)))
+ (progn (if comint-eol-on-send
+ (if comint-use-prompt-regexp
+ (end-of-line)
+ (goto-char (field-end))))
(buffer-substring pmark (point)))
(let ((copy (funcall comint-get-old-input)))
(goto-char pmark)
Freezes the `font-lock-face' text property in place."
(when comint-last-prompt
(with-silent-modifications
- (add-text-properties
+ (font-lock-prepend-text-property
(car comint-last-prompt)
(cdr comint-last-prompt)
- '(font-lock-face comint-highlight-prompt)))
+ 'font-lock-face 'comint-highlight-prompt))
;; Reset comint-last-prompt so later on comint-output-filter does
;; not remove the font-lock-face text property of the previous
;; (this) prompt.
(add-text-properties prompt-start (point)
'(read-only t front-sticky (read-only)))))
(when comint-last-prompt
- (remove-text-properties (car comint-last-prompt)
- (cdr comint-last-prompt)
- '(font-lock-face)))
+ (with-silent-modifications
+ (font-lock--remove-face-from-text-property
+ (car comint-last-prompt)
+ (cdr comint-last-prompt)
+ 'font-lock-face
+ 'comint-highlight-prompt)))
(setq comint-last-prompt
(cons (copy-marker prompt-start) (point-marker)))
- (add-text-properties prompt-start (point)
- '(rear-nonsticky t
- font-lock-face comint-highlight-prompt)))
+ (with-silent-modifications
+ (font-lock-prepend-text-property prompt-start (point)
+ 'font-lock-face
+ 'comint-highlight-prompt)
+ (add-text-properties prompt-start (point) '(rear-nonsticky t))))
(goto-char saved-point)))))))
(defun comint-preinput-scroll-to-bottom ()
(null (get-char-property (setq bof (field-beginning)) 'field)))
(field-string-no-properties bof)
(comint-bol)
- (buffer-substring-no-properties (point) (line-end-position)))))
+ (buffer-substring-no-properties (point)
+ (if comint-use-prompt-regexp
+ (line-end-position)
+ (field-end))))))
(defun comint-copy-old-input ()
"Insert after prompt old input at point as new input to be edited.
;; if there are two fields on a line, then the first one is the
;; prompt, and the second one is an input field, and is front-sticky
;; (as input fields should be).
- (constrain-to-field (line-beginning-position) (line-end-position))))
+ (constrain-to-field (if (eq (field-at-pos (point)) 'output)
+ (line-beginning-position)
+ (field-beginning))
+ (line-end-position))))
(defun comint-bol (&optional arg)
"Go to the beginning of line, then skip past the prompt, if any.
(goto-char (field-beginning pos))
(set-window-start (selected-window) (point))))))
+(defun comint-clear-buffer ()
+ "Clear the comint buffer."
+ (interactive)
+ (let ((comint-buffer-maximum-size 0))
+ (comint-truncate-buffer)))
(defun comint-interrupt-subjob ()
"Interrupt the current subjob.
-;;; delsel.el --- delete selection if you insert
+;;; delsel.el --- delete selection if you insert -*- lexical-binding:t -*-
;; Copyright (C) 1992, 1997-1998, 2001-2015 Free Software Foundation,
;; Inc.
;; property on their symbols; commands which insert text but don't
;; have this property won't delete the selection. It can be one of
;; the values:
-;; 'yank
+;; `yank'
;; For commands which do a yank; ensures the region about to be
;; deleted isn't yanked.
-;; 'supersede
+;; `supersede'
;; Delete the active region and ignore the current command,
;; i.e. the command will just delete the region.
-;; 'kill
-;; `kill-region' is used on the selection, rather than
-;; `delete-region'. (Text selected with the mouse will typically
-;; be yankable anyhow.)
;; t
;; The normal case: delete the active region prior to executing
;; the command which will insert replacement text.
(cons (current-buffer)
(and (consp buffer-undo-list) (car buffer-undo-list)))))
(t
- (funcall region-extract-function 'delete-only)))
- t)
+ (funcall region-extract-function 'delete-only))))
(defun delete-selection-repeat-replace-region (arg)
"Repeat replacing text of highlighted region with typed text.
For commands which need to dynamically determine this behavior.
FUNCTION should take no argument and return one of the above values or nil."
(condition-case data
- (cond ((eq type 'kill)
+ (cond ((eq type 'kill) ;Deprecated, backward compatibility.
(delete-active-region t)
(if (and overwrite-mode
(eq this-command 'self-insert-command))
(put 'newline-and-indent 'delete-selection t)
(put 'newline 'delete-selection t)
(put 'electric-newline-and-maybe-indent 'delete-selection t)
-(put 'open-line 'delete-selection 'kill)
+(put 'open-line 'delete-selection t)
;; This is very useful for canceling a selection in the minibuffer without
;; aborting the minibuffer.
(require 'cl-lib)
(require 'frameset)
-(defvar desktop-file-version "206"
+(defvar desktop-file-version "208"
"Version number of desktop file format.
Written into the desktop file and used at desktop read to provide
backward compatibility.")
"When the desktop file was last modified to the knowledge of this Emacs.
Used to detect desktop file conflicts.")
+(defvar desktop-var-serdes-funs
+ (list (list
+ 'mark-ring
+ (lambda (mr)
+ (mapcar #'marker-position mr))
+ (lambda (mr)
+ (mapcar #'copy-marker mr))))
+ "Table of serialization/deserialization functions for variables.
+Each record is a list of form: (var serializer deserializer).
+These records can be freely reordered, deleted, or new ones added.
+However, for compatibility, don't modify the functions for existing records.")
+
(defun desktop-owner (&optional dirname)
"Return the PID of the Emacs process that owns the desktop file in DIRNAME.
Return nil if no desktop file found or no Emacs process is using it.
;; ----------------------------------------------------------------------------
(defun desktop-buffer-info (buffer)
+ "Return information describing BUFFER.
+This function is not pure, as BUFFER is made current with
+`set-buffer'.
+
+Returns a list of all the necessary information to recreate the
+buffer, which is (in order):
+
+ `uniquify-buffer-base-name';
+ `buffer-file-name';
+ `buffer-name';
+ `major-mode';
+ list of minor-modes,;
+ `point';
+ `mark';
+ `buffer-read-only';
+ auxiliary information given by `desktop-save-buffer';
+ local variables;
+ auxiliary information given by `desktop-var-serdes-funs'."
(set-buffer buffer)
(list
;; base name of the buffer; replaces the buffer name if managed by uniquify
major-mode
;; minor modes
(let (ret)
- (mapc
- #'(lambda (minor-mode)
- (and (boundp minor-mode)
- (symbol-value minor-mode)
- (let* ((special (assq minor-mode desktop-minor-mode-table))
- (value (cond (special (cadr special))
- ((functionp minor-mode) minor-mode))))
- (when value (add-to-list 'ret value)))))
- (mapcar #'car minor-mode-alist))
- ret)
+ (dolist (minor-mode (mapcar #'car minor-mode-alist) ret)
+ (and (boundp minor-mode)
+ (symbol-value minor-mode)
+ (let* ((special (assq minor-mode desktop-minor-mode-table))
+ (value (cond (special (cadr special))
+ ((functionp minor-mode) minor-mode))))
+ (when value (cl-pushnew value ret))))))
;; point and mark, and read-only status
(point)
(list (mark t) mark-active)
(push here ll))
((member local loclist)
(push local ll)))))
- ll)))
+ ll)
+ (mapcar (lambda (record)
+ (let ((var (car record)))
+ (list var
+ (funcall (cadr record) (symbol-value var)))))
+ desktop-var-serdes-funs)))
;; ----------------------------------------------------------------------------
(defun desktop--v2s (value)
(desktop-buffer-fail-count 0)
(owner (desktop-owner))
;; Avoid desktop saving during evaluation of desktop buffer.
- (desktop-save nil))
+ (desktop-save nil)
+ (desktop-autosave-was-enabled))
(if (and owner
(memq desktop-load-locked-desktop '(nil ask))
(or (null desktop-load-locked-desktop)
;; Temporarily disable the autosave that will leave it
;; disabled when loading the desktop fails with errors,
;; thus not overwriting the desktop with broken contents.
+ (setq desktop-autosave-was-enabled
+ (memq 'desktop-auto-save-set-timer window-configuration-change-hook))
(desktop-auto-save-disable)
;; Evaluate desktop buffer and remember when it was modified.
(load (desktop-full-file-name) t t t)
(set-window-prev-buffers window nil)
(set-window-next-buffers window nil))))
(setq desktop-saved-frameset nil)
- (desktop-auto-save-enable)
+ (if desktop-autosave-was-enabled (desktop-auto-save-enable))
t))
;; No desktop file found.
(let ((default-directory desktop-dirname))
buffer-readonly
buffer-misc
&optional
- buffer-locals)
+ buffer-locals
+ compacted-vars
+ &rest _unsupported)
(let ((desktop-file-version file-version)
(desktop-buffer-file-name buffer-filename)
(set (car this) (cdr this)))
;; An entry of the form `symbol'.
(make-local-variable this)
- (makunbound this))))))))
+ (makunbound this)))
+ (unless (< desktop-file-version 208) ; Don't misinterpret any old custom args
+ (dolist (record compacted-vars)
+ (let*
+ ((var (car record))
+ (deser-fun (cl-caddr (assq var desktop-var-serdes-funs))))
+ (if deser-fun (set var (funcall deser-fun (cadr record))))))))
+ result))))
;; ----------------------------------------------------------------------------
;; Backward compatibility -- update parameters to 205 standards.
;; to e.g. recursive-delete-file and put it somewhere else.
(defun dired-delete-file (file &optional recursive trash) "\
Delete FILE or directory (possibly recursively if optional RECURSIVE is true.)
-RECURSIVE determines what to do with a non-empty directory. If RECURSIVE is:
-nil, do not delete.
-`always', delete recursively without asking.
-`top', ask for each directory at top level.
-Anything else, ask for each sub-directory."
+RECURSIVE determines what to do with a non-empty directory. The effect of
+its possible values is:
+
+ nil -- do not delete.
+ `always' -- delete recursively without asking.
+ `top' -- ask for each directory at top level.
+ Anything else -- ask for each sub-directory.
+
+TRASH non-nil means to trash the file instead of deleting, provided
+`delete-by-moving-to-trash' (which see) is non-nil."
;; This test is equivalent to
;; (and (file-directory-p fn) (not (file-symlink-p fn)))
;; but more efficient
(define-key map "H" 'doc-view-fit-height-to-window)
(define-key map "P" 'doc-view-fit-page-to-window)
;; Killing the buffer (and the process)
- (define-key map (kbd "k") 'doc-view-kill-proc-and-buffer)
(define-key map (kbd "K") 'doc-view-kill-proc)
;; Slicing the image
(define-key map (kbd "s s") 'doc-view-set-slice)
(setq doc-view--current-timer nil))
(setq mode-line-process nil))
-(defun doc-view-kill-proc-and-buffer ()
- "Kill the current converter process and buffer."
- (interactive)
- (doc-view-kill-proc)
- (when (eq major-mode 'doc-view-mode)
- (kill-buffer (current-buffer))))
+(define-obsolete-function-alias 'doc-view-kill-proc-and-buffer
+ #'image-kill-buffer "25.1")
(defun doc-view-make-safe-dir (dir)
(condition-case nil
;; desktop.el integration
(defun doc-view-desktop-save-buffer (_desktop-dirname)
+ ;; FIXME: This is wrong, since this info is per-window but we only do it once
+ ;; here for the buffer. IOW it should be saved via something like
+ ;; `window-persistent-parameters'.
`((page . ,(doc-view-current-page))
(slice . ,(doc-view-current-slice))))
(let ((page (cdr (assq 'page misc)))
(slice (cdr (assq 'slice misc))))
(desktop-restore-file-buffer file name misc)
+ ;; FIXME: We need to run this code after displaying the buffer.
(with-selected-window (or (get-buffer-window (current-buffer) 0)
(selected-window))
+ ;; FIXME: This should be done for all windows restored that show
+ ;; this buffer. Basically, the page/slice should be saved as
+ ;; window-parameters in the window-state(s) and then restoring this
+ ;; window-state should call us back (to interpret/use those parameters).
(doc-view-goto-page page)
(when slice (apply 'doc-view-set-slice slice)))))
(setq result (dom-parent elem node))))
result)))
+(defun dom-previous-sibling (dom node)
+ (when-let (parent (dom-parent dom node))
+ (let ((siblings (dom-children parent))
+ (previous nil))
+ (while siblings
+ (when (eq (cadr siblings) node)
+ (setq previous (car siblings)))
+ (pop siblings))
+ previous)))
+
(defun dom-node (tag &optional attributes &rest children)
"Return a DOM node with TAG and ATTRIBUTES."
(if children
Electric Pair mode is a global minor mode. When enabled, typing
an open parenthesis automatically inserts the corresponding
-closing parenthesis. (Likewise for brackets, etc.)."
+closing parenthesis. (Likewise for brackets, etc.). To toggle
+the mode in a single buffer, use `electric-pair-local-mode'."
:global t :group 'electricity
(if electric-pair-mode
(progn
(remove-hook 'self-insert-uses-region-functions
#'electric-pair-will-use-region)))
+;;;###autoload
+(define-minor-mode electric-pair-local-mode
+ "Toggle `electric-pair-mode' only in this buffer."
+ :variable (buffer-local-value 'electric-pair-mode (current-buffer))
+ (cond
+ ((eq electric-pair-mode (default-value 'electric-pair-mode))
+ (kill-local-variable 'electric-pair-mode))
+ ((not (default-value 'electric-pair-mode))
+ ;; Locally enabled, but globally disabled.
+ (electric-pair-mode 1) ; Setup the hooks.
+ (setq-default electric-pair-mode nil) ; But keep it globally disabled.
+ )))
+
(provide 'elec-pair)
;;; elec-pair.el ends here
;; doesn't matter here, because function's behavior is underspecified so it
;; can safely be turned into a `let', even though the reverse is not true.
(or name (setq name "anonymous lambda"))
- (let ((lambda (car form))
- (values (cdr form)))
- (let ((arglist (nth 1 lambda))
- (body (cdr (cdr lambda)))
- optionalp restp
- bindings)
- (if (and (stringp (car body)) (cdr body))
- (setq body (cdr body)))
- (if (and (consp (car body)) (eq 'interactive (car (car body))))
- (setq body (cdr body)))
- ;; FIXME: The checks below do not belong in an optimization phase.
- (while arglist
- (cond ((eq (car arglist) '&optional)
- ;; ok, I'll let this slide because funcall_lambda() does...
- ;; (if optionalp (error "multiple &optional keywords in %s" name))
- (if restp (error "&optional found after &rest in %s" name))
- (if (null (cdr arglist))
- (error "nothing after &optional in %s" name))
- (setq optionalp t))
- ((eq (car arglist) '&rest)
- ;; ...but it is by no stretch of the imagination a reasonable
- ;; thing that funcall_lambda() allows (&rest x y) and
- ;; (&rest x &optional y) in arglists.
- (if (null (cdr arglist))
- (error "nothing after &rest in %s" name))
- (if (cdr (cdr arglist))
- (error "multiple vars after &rest in %s" name))
- (setq restp t))
- (restp
- (setq bindings (cons (list (car arglist)
- (and values (cons 'list values)))
- bindings)
- values nil))
- ((and (not optionalp) (null values))
- (byte-compile-warn "attempt to open-code `%s' with too few arguments" name)
- (setq arglist nil values 'too-few))
- (t
- (setq bindings (cons (list (car arglist) (car values))
- bindings)
- values (cdr values))))
- (setq arglist (cdr arglist)))
- (if values
- (progn
- (or (eq values 'too-few)
- (byte-compile-warn
- "attempt to open-code `%s' with too many arguments" name))
- form)
-
- ;; The following leads to infinite recursion when loading a
- ;; file containing `(defsubst f () (f))', and then trying to
- ;; byte-compile that file.
- ;(setq body (mapcar 'byte-optimize-form body)))
-
- (let ((newform
- (if bindings
- (cons 'let (cons (nreverse bindings) body))
- (cons 'progn body))))
- (byte-compile-log " %s\t==>\t%s" form newform)
- newform)))))
+ (let* ((lambda (car form))
+ (values (cdr form))
+ (arglist (nth 1 lambda))
+ (body (cdr (cdr lambda)))
+ optionalp restp
+ bindings)
+ (if (and (stringp (car body)) (cdr body))
+ (setq body (cdr body)))
+ (if (and (consp (car body)) (eq 'interactive (car (car body))))
+ (setq body (cdr body)))
+ ;; FIXME: The checks below do not belong in an optimization phase.
+ (while arglist
+ (cond ((eq (car arglist) '&optional)
+ ;; ok, I'll let this slide because funcall_lambda() does...
+ ;; (if optionalp (error "multiple &optional keywords in %s" name))
+ (if restp (error "&optional found after &rest in %s" name))
+ (if (null (cdr arglist))
+ (error "nothing after &optional in %s" name))
+ (setq optionalp t))
+ ((eq (car arglist) '&rest)
+ ;; ...but it is by no stretch of the imagination a reasonable
+ ;; thing that funcall_lambda() allows (&rest x y) and
+ ;; (&rest x &optional y) in arglists.
+ (if (null (cdr arglist))
+ (error "nothing after &rest in %s" name))
+ (if (cdr (cdr arglist))
+ (error "multiple vars after &rest in %s" name))
+ (setq restp t))
+ (restp
+ (setq bindings (cons (list (car arglist)
+ (and values (cons 'list values)))
+ bindings)
+ values nil))
+ ((and (not optionalp) (null values))
+ (byte-compile-warn "attempt to open-code `%s' with too few arguments" name)
+ (setq arglist nil values 'too-few))
+ (t
+ (setq bindings (cons (list (car arglist) (car values))
+ bindings)
+ values (cdr values))))
+ (setq arglist (cdr arglist)))
+ (if values
+ (progn
+ (or (eq values 'too-few)
+ (byte-compile-warn
+ "attempt to open-code `%s' with too many arguments" name))
+ form)
+
+ ;; The following leads to infinite recursion when loading a
+ ;; file containing `(defsubst f () (f))', and then trying to
+ ;; byte-compile that file.
+ ;(setq body (mapcar 'byte-optimize-form body)))
+
+ (let ((newform
+ (if bindings
+ (cons 'let (cons (nreverse bindings) body))
+ (cons 'progn body))))
+ (byte-compile-log " %s\t==>\t%s" form newform)
+ newform))))
\f
;;; implementing source-level optimizers
(and (nth 1 form)
(not for-effect)
form))
- ((eq 'lambda (car-safe fn))
+ ((eq (car-safe fn) 'lambda)
(let ((newform (byte-compile-unfold-lambda form)))
(if (eq newform form)
;; Some error occurred, avoid infinite recursion
form
(byte-optimize-form-code-walker newform for-effect))))
+ ((eq (car-safe fn) 'closure) form)
((memq fn '(let let*))
;; recursively enter the optimizer for the bindings and body
;; of a let or let*. This for depth-firstness: forms that
(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)
+ #'(lambda (name _args spec)
+ (list 'progn :autoload-end
+ (list 'put (list 'quote name)
+ ''edebug-form-spec (list 'quote spec)))))
+ (cons
+ (list 'no-font-lock-keyword
+ #'(lambda (name _args val)
+ (list 'function-put (list 'quote name)
+ ''no-font-lock-keyword (list 'quote val))))
+ 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
(message "Warning: Unknown macro property %S in %S"
(car x) name))))
decls)))
+ ;; Refresh font-lock if this is a new macro, or it is an
+ ;; existing macro whose 'no-font-lock-keyword declaration
+ ;; has changed.
+ (if (and
+ ;; If lisp-mode hasn't been loaded, there's no reason
+ ;; to flush.
+ (fboundp 'lisp--el-font-lock-flush-elisp-buffers)
+ (or (not (fboundp name)) ;; new macro
+ (and (fboundp name) ;; existing macro
+ (member `(function-put ',name 'no-font-lock-keyword
+ ',(get name 'no-font-lock-keyword))
+ declarations))))
+ (lisp--el-font-lock-flush-elisp-buffers))
(if declarations
(cons 'prog1 (cons def declarations))
def))))))
This uses `defvaralias' and `make-obsolete-variable' (which see).
See the Info node `(elisp)Variable Aliases' for more details.
-If CURRENT-NAME is a defcustom (more generally, any variable
+If CURRENT-NAME is a defcustom or a defvar (more generally, any variable
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
For the benefit of `custom-set-variables', if OBSOLETE-NAME has
any of the following properties, they are copied to
CURRENT-NAME, if it does not already have them:
-'saved-value, 'saved-variable-comment."
+`saved-value', `saved-variable-comment'."
(declare (doc-string 4)
(advertised-calling-convention
;; New code should always provide the `when' argument.
;; faster. [`LAP' == `Lisp Assembly Program'.]
;; The user entry points are byte-compile-file and byte-recompile-directory.
+;;; Todo:
+
+;; - Turn "not bound at runtime" functions into autoloads.
+
;;; Code:
;; ========================================================================
(eval-when-compile . ,(lambda (&rest body)
(let ((result nil))
(byte-compile-recurse-toplevel
- (cons 'progn body)
+ (macroexp-progn body)
(lambda (form)
(setf result
(byte-compile-eval
(list 'quote result))))
(eval-and-compile . ,(lambda (&rest body)
(byte-compile-recurse-toplevel
- (cons 'progn body)
+ (macroexp-progn body)
(lambda (form)
;; Don't compile here, since we don't know
;; whether to compile as byte-compile-form
(let ((keyword-args (cdr (cdr (cdr (cdr form)))))
(name (cadr form)))
(or (not (eq (car-safe name) 'quote))
- (and (eq (car form) 'custom-declare-group)
- (equal name ''emacs))
- (plist-get keyword-args :group)
- (not (and (consp name) (eq (car name) 'quote)))
- (byte-compile-warn
- "%s for `%s' fails to specify containing group"
- (cdr (assq (car form)
+ (and (eq (car form) 'custom-declare-group)
+ (equal name ''emacs))
+ (plist-get keyword-args :group)
+ (not (and (consp name) (eq (car name) 'quote)))
+ (byte-compile-warn
+ "%s for `%s' fails to specify containing group"
+ (cdr (assq (car form)
'((custom-declare-group . defgroup)
(custom-declare-face . defface)
(custom-declare-variable . defcustom))))
;; These would sometimes be warned about
;; but such warnings are never useful,
;; so don't warn about them.
- macroexpand cl-macroexpand-all
+ macroexpand
cl--compiling-file))))
(byte-compile-warn "function `%s' from cl package called at runtime"
func)))
form))
(put 'define-abbrev-table 'byte-hunk-handler
- 'byte-compile-file-form-define-abbrev-table)
-(defun byte-compile-file-form-define-abbrev-table (form)
- (if (eq 'quote (car-safe (car-safe (cdr form))))
- (byte-compile--declare-var (car-safe (cdr (cadr form)))))
+ 'byte-compile-file-form-defvar-function)
+(put 'defvaralias 'byte-hunk-handler 'byte-compile-file-form-defvar-function)
+
+(defun byte-compile-file-form-defvar-function (form)
+ (pcase-let (((or `',name (let name nil)) (nth 1 form)))
+ (if name (byte-compile--declare-var name)))
(byte-compile-keep-pending form))
(put 'custom-declare-variable 'byte-hunk-handler
(defun byte-compile-file-form-custom-declare-variable (form)
(when (byte-compile-warning-enabled-p 'callargs)
(byte-compile-nogroup-warn form))
- (byte-compile--declare-var (nth 1 (nth 1 form)))
- (byte-compile-keep-pending form))
+ (byte-compile-file-form-defvar-function form))
(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
(defun byte-compile-file-form-require (form)
fun)
(t
(when (symbolp form)
- (unless (memq (car-safe fun) '(closure lambda))
- (error "Don't know how to compile %S" fun))
(setq lexical-binding (eq (car fun) 'closure))
(setq fun (byte-compile--reify-function fun)))
- (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))
+ (setq fun (byte-compile-top-level fun nil 'eval))
(if macro (push 'macro fun))
(if (symbolp form)
(fset form fun)
(interactive-only
(or (get fn 'interactive-only)
(memq fn byte-compile-interactive-only-functions))))
+ (when (memq fn '(set symbol-value run-hooks ;; add-to-list
+ add-hook remove-hook run-hook-with-args
+ run-hook-with-args-until-success
+ run-hook-with-args-until-failure))
+ (pcase (cdr form)
+ (`(',var . ,_)
+ (when (assq var byte-compile-lexical-variables)
+ (byte-compile-log-warning
+ (format "%s cannot use lexical var `%s'" fn var)
+ nil :error)))))
(when (macroexp--const-symbol-p fn)
(byte-compile-warn "`%s' called as a function" fn))
(when (and (byte-compile-warning-enabled-p 'interactive-only)
(dotimes (_ (- (/ (1+ fmax2) 2) alen))
(byte-compile-push-constant nil)))
((zerop (logand fmax2 1))
- (byte-compile-log-warning "Too many arguments for inlined function"
- nil :error)
+ (byte-compile-log-warning
+ (format "Too many arguments for inlined function %S" form)
+ nil :error)
(byte-compile-discard (- alen (/ fmax2 2))))
(t
;; Turn &rest args into a list.
(if byte-compile--for-effect (setq byte-compile--for-effect nil)
(let* ((vars (nth 1 form))
(env (nth 2 form))
- (body (nthcdr 3 form))
+ (docstring-exp (nth 3 form))
+ (body (nthcdr 4 form))
(fun
(byte-compile-lambda `(lambda ,vars . ,body) nil (length env))))
- (cl-assert (> (length env) 0)) ;Otherwise, we don't need a closure.
+ (cl-assert (or (> (length env) 0)
+ docstring-exp)) ;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))
- ,@(nthcdr 3 (mapcar (lambda (x) `',x) fun)))))))
+ ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun))))
+ (if docstring-exp
+ `(,(car rest)
+ ,docstring-exp
+ ,@(cddr rest))
+ rest)))))))
(defun byte-compile-get-closed-var (form)
"Byte-compile the special `internal-get-closed-var' form."
;; if the function is suitable for lambda lifting (if all calls are known)
;;
;; (lambda (v0 ...) ... fv0 .. fv1 ...) =>
-;; (internal-make-closure (v0 ...) (fv1 ...)
+;; (internal-make-closure (v0 ...) (fv0 ...) <doc>
;; ... (internal-get-closed-var 0) ... (internal-get-closed-var 1) ...)
;;
;; If the function has no free variables, we don't do anything.
;;
;;; Code:
+;; PROBLEM cases found during conversion to lexical binding.
+;; We should try and detect and warn about those cases, even
+;; for lexical-binding==nil to help prepare the migration.
+;; - Uses of run-hooks, and friends.
+;; - Cases where we want to apply the same code to different vars depending on
+;; some test. These sometimes use a (let ((foo (if bar 'a 'b)))
+;; ... (symbol-value foo) ... (set foo ...)).
+
;; TODO: (not just for cconv but also for the lexbind changes in general)
;; - let (e)debug find the value of lexical variables from the stack.
;; - make eval-region do the eval-sexp-add-defvars dance.
;; the bytecomp only compiles it once.
;; - Since we know here when a variable is not mutated, we could pass that
;; info to the byte-compiler, e.g. by using a new `immutable-let'.
-;; - add tail-calls to bytecode.c and the byte compiler.
;; - call known non-escaping functions with `goto' rather than `call'.
-;; - optimize mapcar to a while loop.
+;; - optimize mapc to a dolist loop.
;; (defmacro dlet (binders &rest body)
;; ;; Works in both lexical and non-lexical mode.
(unless (memq (car b) s) (push b res)))
(nreverse res)))
-(defun cconv--convert-function (args body env parentform)
+(defun cconv--convert-function (args body env parentform &optional docstring)
(cl-assert (equal body (caar cconv-freevars-alist)))
(let* ((fvs (cdr (pop cconv-freevars-alist)))
(body-new '())
`(,@(nreverse special-forms) (let ,letbind . ,body-new)))))
(cond
- ((null envector) ;if no freevars - do nothing
+ ((not (or envector docstring)) ;If no freevars - do nothing.
`(function (lambda ,args . ,body-new)))
(t
`(internal-make-closure
- ,args ,envector . ,body-new)))))
+ ,args ,envector ,docstring . ,body-new)))))
(defun cconv-convert (form env extend)
;; This function actually rewrites the tree.
cond-forms)))
(`(function (lambda ,args . ,body) . ,_)
- (cconv--convert-function args body env form))
+ (let ((docstring (if (eq :documentation (car-safe (car body)))
+ (cconv-convert (cadr (pop body)) env extend))))
+ (cconv--convert-function args body env form docstring)))
(`(internal-make-closure . ,_)
(byte-compile-report-error
;; use = `(,binder ,read ,mutated ,captured ,called)
(pcase vardata
(`(,_ nil nil nil nil) nil)
- (`((,(and (pred (lambda (var) (eq ?_ (aref (symbol-name var) 0)))) var) . ,_)
+ (`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_)
,_ ,_ ,_ ,_)
(byte-compile-log-warning
(format "%s `%S' not left unused" varkind var))))
(cconv--analyze-use vardata form "variable"))))
(`(function (lambda ,vrs . ,body-forms))
+ (when (eq :documentation (car-safe (car body-forms)))
+ (cconv-analyze-form (cadr (pop body-forms)) env))
(cconv--analyze-function vrs body-forms env form))
(`(setq . ,forms)
(dolist (forms cond-forms)
(dolist (form forms) (cconv-analyze-form form env))))
+ ;; ((and `(quote ,v . ,_) (guard (assq v env)))
+ ;; (byte-compile-log-warning
+ ;; (format "Possible confusion variable/symbol for `%S'" v)))
+
(`(quote . ,_) nil) ; quote form
(`(function . ,_) nil) ; same as quote
(autoload 'byte-compile-arglist-signature "bytecomp")
+(defgroup check-declare nil
+ "Check declare-function statements."
+ :group 'tools)
+
+(defcustom check-declare-ext-errors nil
+ "When non-nil, warn about functions not found in :ext."
+ :type 'boolean)
+
(defun check-declare-verify (fnfile fnlist)
"Check that FNFILE contains function definitions matching FNLIST.
Each element of FNLIST has the form (FILE FN ARGLIST FILEONLY), where
(when type
(setq errlist (cons (list (car e) (cadr e) type) errlist))))
(message "%s%s" m
- (if (or re (not ext))
+ (if (or re (or check-declare-ext-errors
+ (not ext)))
(check-declare-errmsg errlist)
(progn
(setq errlist nil)
"Warn that FILE made a false claim about FN in FNFILE.
TYPE is a string giving the nature of the error. Warning is displayed in
`check-declare-warning-buffer'."
- (display-warning 'check-declare
- (format "%s said `%s' was defined in %s: %s"
- (file-name-nondirectory file) fn
- (file-name-nondirectory fnfile)
- type)
- nil check-declare-warning-buffer))
+ (let ((warning-prefix-function
+ (lambda (level entry)
+ (let ((line 0)
+ (col 0))
+ (insert
+ (with-current-buffer (find-file-noselect file)
+ (goto-char (point-min))
+ (when (re-search-forward
+ (format "(declare-function[ \t\n]+%s" fn) nil t)
+ (goto-char (match-beginning 0))
+ (setq line (line-number-at-pos))
+ (setq col (1+ (current-column))))
+ (format "%s:%d:%d:"
+ (file-name-nondirectory file)
+ line col))))
+ entry))
+ (warning-fill-prefix " "))
+ (display-warning 'check-declare
+ (format "%s said `%s' was defined in %s: %s"
+ (file-name-nondirectory file) fn
+ (file-name-nondirectory fnfile)
+ type)
+ nil check-declare-warning-buffer)))
(defun check-declare-files (&rest files)
"Check veracity of all `declare-function' statements in FILES.
(dolist (e (check-declare-sort alist))
(if (setq err (check-declare-verify (car e) (cdr e)))
(setq errlist (cons (cons (car e) err) errlist))))
+ (setq errlist (nreverse errlist))
(if (get-buffer check-declare-warning-buffer)
(kill-buffer check-declare-warning-buffer))
+ (with-current-buffer (get-buffer-create check-declare-warning-buffer)
+ (unless (derived-mode-p 'compilation-mode)
+ (compilation-mode))
+ (let ((inhibit-read-only t))
+ (insert "\f\n"))
+ (compilation-forget-errors))
;; Sort back again so that errors are ordered by the files
;; containing the declare-function statements.
(dolist (e (check-declare-sort errlist))
- (dolist (f (cdr e))
- (check-declare-warn (car e) (cadr f) (car f) (nth 2 f))))
+ (dolist (f (cdr e))
+ (check-declare-warn (car e) (cadr f) (car f) (nth 2 f))))
errlist))
;;;###autoload
;; Addendum: Make sure they appear in the doc in the same
;; order that they are found in the arg list.
- (let ((args (cdr (cdr (cdr (cdr fp)))))
+ (let ((args (nthcdr 4 fp))
(last-pos 0)
(found 1)
(order (and (nth 3 fp) (car (nth 3 fp))))
(nocheck (append '("&optional" "&rest") (nth 3 fp)))
(inopts nil))
(while (and args found (> found last-pos))
- (if (member (car args) nocheck)
+ (if (or (member (car args) nocheck)
+ (string-match "\\`_" (car args)))
(setq args (cdr args)
inopts t)
(setq last-pos found
(defun checkdoc-show-diagnostics ()
"Display the checkdoc diagnostic buffer in a temporary window."
(if checkdoc-pending-errors
- (let ((b (get-buffer checkdoc-diagnostic-buffer)))
- (if b (progn (pop-to-buffer b)
- (goto-char (point-max))
- (re-search-backward "\C-l" nil t)
- (beginning-of-line)
- (forward-line 1)
- (recenter 0)))
- (other-window -1)
+ (let* ((b (get-buffer checkdoc-diagnostic-buffer))
+ (win (if b (display-buffer b))))
+ (when win
+ (with-selected-window win
+ (goto-char (point-max))
+ (re-search-backward "\C-l" nil t)
+ (beginning-of-line)
+ (forward-line 1)
+ (recenter 0)))
(setq checkdoc-pending-errors nil)
nil)))
;; Copyright (C) 2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Version: 1.0
;; This file is part of GNU Emacs.
;; from a significant problem: the method-combination code returns a sexp
;; that needs to be `eval'uated or compiled. IOW it requires run-time
;; code generation. Given how rarely method-combinations are used,
-;; I just provided a cl-generic-method-combination-function, which
-;; people can use if they are really desperate for such functionality.
+;; I just provided a cl-generic-combine-methods generic function, to which
+;; people can add methods if they are really desperate for such functionality.
;; - In defgeneric we don't support the options:
-;; declare, :method-combination, :generic-function-class, :method-class,
-;; :method.
+;; declare, :method-combination, :generic-function-class, :method-class.
;; Added elements:
;; - We support aliases to generic functions.
-;; - The kind of thing on which to dispatch can be extended.
-;; There is support in this file for dispatch on:
+;; - cl-generic-generalizers. This generic function lets you extend the kind
+;; of thing on which to dispatch. There is support in this file for
+;; dispatch on:
;; - (eql <val>)
+;; - (head <val>) which checks that the arg is a cons with <val> as its head.
;; - plain old types
;; - type of CL structs
;; eieio-core adds dispatch on:
;; - class of eieio objects
;; - actual class argument, using the syntax (subclass <class>).
-;; - cl-generic-method-combination-function (i.s.o define-method-combination).
+;; - cl-generic-combine-methods (i.s.o define-method-combination and
+;; compute-effective-method).
;; - cl-generic-call-method (which replaces make-method and call-method).
+;; - The standard method combination supports ":extra STRING" qualifiers
+;; which simply allows adding more methods for the same
+;; specializers&qualifiers.
;; Efficiency considerations: overall, I've made an effort to make this fairly
;; efficient for the expected case (e.g. no constant redefinition of methods).
;; - Generic functions which do not dispatch on any argument are implemented
;; optimally (just as efficient as plain old functions).
;; - Generic functions which only dispatch on one argument are fairly efficient
-;; (not a lot of room for improvement, I think).
+;; (not a lot of room for improvement without changes to the byte-compiler,
+;; I think).
;; - Multiple dispatch is implemented rather naively. There's an extra `apply'
;; function call for every dispatch; we don't optimize each dispatch
;; based on the set of candidate methods remaining; we don't optimize the
-;; order in which we performs the dispatches either; If/when this
-;; becomes a problem, we can try and optimize it.
+;; order in which we performs the dispatches either;
+;; If/when this becomes a problem, we can try and optimize it.
;; - call-next-method could be made more efficient, but isn't too terrible.
+;; TODO:
+;;
+;; - A generic "filter" generalizer (e.g. could be used to cleanly adds methods
+;; to cl-generic-combine-methods with a specializer that says it applies only
+;; when some particular qualifier is used).
+;; - A way to dispatch on the context (e.g. the major-mode, some global
+;; variable, you name it).
+
;;; Code:
;; Note: For generic functions that dispatch on several arguments (i.e. those
;; often suboptimal since after one dispatch, the remaining dispatches can
;; usually be simplified, or even completely skipped.
-;; TODO/FIXME:
-;; - WIBNI we could use something like
-;; (add-function :before (cl-method-function (cl-find-method ...)) ...)
-
(eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'pcase))
-(defvar cl-generic-tagcode-function
- (lambda (type _name)
- (if (eq type t) '(0 . 'cl--generic-type)
- (error "Unknown specializer %S" type)))
- "Function to get the Elisp code to extract the tag on which we dispatch.
-Takes a \"parameter-specializer-name\" and a variable name, and returns
-a pair (PRIORITY . CODE) where CODE is an Elisp expression that should be
-used to extract the \"tag\" (from the object held in the named variable)
-that should uniquely determine if we have a match
-\(i.e. the \"tag\" is the value that will be used to dispatch to the proper
-method(s)).
-Such \"tagcodes\" will be or'd together.
-PRIORITY is an integer from 0 to 100 which is used to sort the tagcodes
-in the `or'. The higher the priority, the more specific the tag should be.
-More specifically, if PRIORITY is N and we have two objects X and Y
-whose tag (according to TAGCODE) is `eql', then it should be the case
-that for all other (PRIORITY . TAGCODE) where PRIORITY ≤ N, then
-\(eval TAGCODE) for X is `eql' to (eval TAGCODE) for Y.")
-
-(defvar cl-generic-tag-types-function
- (lambda (tag) (if (eq tag 'cl--generic-type) '(t)))
- "Function to get the list of types that a given \"tag\" matches.
-They should be sorted from most specific to least specific.")
+(cl-defstruct (cl--generic-generalizer
+ (:constructor nil)
+ (:constructor cl-generic-make-generalizer
+ (priority tagcode-function specializers-function)))
+ (priority nil :type integer)
+ tagcode-function
+ specializers-function)
+
+(defconst cl--generic-t-generalizer
+ (cl-generic-make-generalizer
+ 0 (lambda (_name) nil) (lambda (_tag) '(t))))
(cl-defstruct (cl--generic-method
(:constructor nil)
- (:constructor cl--generic-method-make
+ (:constructor cl--generic-make-method
(specializers qualifiers uses-cnm function))
(:predicate nil))
(specializers nil :read-only t :type list)
(cl-defstruct (cl--generic
(:constructor nil)
- (:constructor cl--generic-make
- (name &optional dispatches method-table))
+ (:constructor cl--generic-make (name))
(:predicate nil))
(name nil :type symbol :read-only t) ;Pointer back to the symbol.
;; `dispatches' holds a list of (ARGNUM . TAGCODES) where ARGNUM is the index
;; on which to dispatch and PRIORITY is the priority of each expression to
;; decide in which order to sort them.
;; The most important dispatch is last in the list (and the least is first).
- (dispatches nil :type (list-of (cons natnum (list-of tagcode))))
- (method-table nil :type (list-of cl--generic-method)))
+ (dispatches nil :type (list-of (cons natnum (list-of generalizers))))
+ (method-table nil :type (list-of cl--generic-method))
+ (options nil :type list))
+
+(defun cl-generic-function-options (generic)
+ "Return the options of the generic function GENERIC."
+ (cl--generic-options generic))
(defmacro cl--generic (name)
`(get ,name 'cl--generic))
With this implementation the ARGS are currently ignored.
OPTIONS-AND-METHODS currently understands:
- (:documentation DOCSTRING)
-- (declare DECLARATIONS)"
+- (declare DECLARATIONS)
+- (:argument-precedence-order &rest ARGS)
+- (:method [QUALIFIERS...] ARGS &rest BODY)
+BODY, if present, is used as the body of a default method.
+
+\(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest BODY)"
(declare (indent 2) (doc-string 3))
- (let* ((docprop (assq :documentation options-and-methods))
- (doc (cond ((stringp (car-safe options-and-methods))
- (pop options-and-methods))
- (docprop
- (prog1
- (cadr docprop)
- (setq options-and-methods
- (delq docprop options-and-methods))))))
- (declarations (assq 'declare options-and-methods)))
- (when declarations
- (setq options-and-methods
- (delq declarations options-and-methods)))
+ (let* ((doc (if (stringp (car-safe options-and-methods))
+ (pop options-and-methods)))
+ (declarations nil)
+ (methods ())
+ (options ())
+ next-head)
+ (while (progn (setq next-head (car-safe (car options-and-methods)))
+ (or (keywordp next-head)
+ (eq next-head 'declare)))
+ (pcase next-head
+ (`:documentation
+ (when doc (error "Multiple doc strings for %S" name))
+ (setq doc (cadr (pop options-and-methods))))
+ (`declare
+ (when declarations (error "Multiple `declare' for %S" name))
+ (setq declarations (pop options-and-methods)))
+ (`:method (push (cdr (pop options-and-methods)) methods))
+ (_ (push (pop options-and-methods) options))))
+ (when options-and-methods
+ ;; Anything remaining is assumed to be a default method body.
+ (push `(,args ,@options-and-methods) methods))
`(progn
,(when (eq 'setf (car-safe name))
(pcase-let ((`(,setter . ,code) (cl--generic-setf-rewrite
nil))))
(cdr declarations))
(defalias ',name
- (cl-generic-define ',name ',args ',options-and-methods)
- ,(help-add-fundoc-usage doc args)))))
+ (cl-generic-define ',name ',args ',(nreverse options))
+ ,(help-add-fundoc-usage doc args))
+ ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
+ (nreverse methods)))))
(defun cl--generic-mandatory-args (args)
(let ((res ()))
(nreverse res)))
;;;###autoload
-(defun cl-generic-define (name args options-and-methods)
+(defun cl-generic-define (name args options)
(let ((generic (cl-generic-ensure-function name))
(mandatory (cl--generic-mandatory-args args))
- (apo (assq :argument-precedence-order options-and-methods)))
+ (apo (assq :argument-precedence-order options)))
(setf (cl--generic-dispatches generic) nil)
(when apo
(dolist (arg (cdr apo))
(push (list (- (length mandatory) (length pos)))
(cl--generic-dispatches generic)))))
(setf (cl--generic-method-table generic) nil)
+ (setf (cl--generic-options generic) options)
(cl--generic-make-function generic)))
(defmacro cl-generic-current-method-specializers ()
"Make the lambda expression for a method with ARGS and BODY."
(let ((plain-args ())
(specializers nil)
- (doc-string (if (and (stringp (car-safe body)) (cdr body))
- (pop body)))
(mandatory t))
(dolist (arg args)
(push (pcase arg
(_ arg))
plain-args))
(setq plain-args (nreverse plain-args))
- (let ((fun `(cl-function (lambda ,plain-args
- ,@(if doc-string (list doc-string))
- ,@body)))
+ (let ((fun `(cl-function (lambda ,plain-args ,@body)))
(macroenv (cons `(cl-generic-current-method-specializers
. ,(lambda () specializers))
macroexpand-all-environment)))
;; destructuring args, `declare' and whatnot).
(pcase (macroexpand fun macroenv)
(`#'(lambda ,args . ,body)
- (let* ((doc-string (and doc-string (stringp (car body)) (cdr body)
- (pop body)))
+ (let* ((parsed-body (macroexp-parse-body body))
(cnm (make-symbol "cl--cnm"))
(nmp (make-symbol "cl--nmp"))
(nbody (macroexpand-all
`(cl-flet ((cl-call-next-method ,cnm)
(cl-next-method-p ,nmp))
- ,@body)
+ ,@(cdr parsed-body))
macroenv))
;; FIXME: Rather than `grep' after the fact, the
;; macroexpansion should directly set some flag when cnm
(uses-cnm (cl--generic-fgrep (list cnm nmp) nbody)))
(cons (not (not uses-cnm))
`#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
- ,@(if doc-string (list doc-string))
+ ,@(car parsed-body)
,(if (not (memq nmp uses-cnm))
nbody
`(let ((,nmp (lambda ()
;; But in practice, it's common to use `cl-defmethod'
;; without a previous `cl-defgeneric'.
(declare-function ,name "")
- (cl-generic-define-method ',name ',qualifiers ',args
+ (cl-generic-define-method ',name ',(nreverse qualifiers) ',args
,uses-cnm ,fun)))))
(defun cl--generic-member-method (specializers qualifiers methods)
(let ((m (car methods)))
(not (and (equal (cl--generic-method-specializers m) specializers)
(equal (cl--generic-method-qualifiers m) qualifiers)))))
- (setq methods (cdr methods))
- methods))
+ (setq methods (cdr methods)))
+ methods)
;;;###autoload
(defun cl-generic-define-method (name qualifiers args uses-cnm function)
(mandatory (cl--generic-mandatory-args args))
(specializers
(mapcar (lambda (arg) (if (consp arg) (cadr arg) t)) mandatory))
- (method (cl--generic-method-make
+ (method (cl--generic-make-method
specializers qualifiers uses-cnm function))
(mt (cl--generic-method-table generic))
(me (cl--generic-member-method specializers qualifiers mt))
(dispatches (cl--generic-dispatches generic))
(i 0))
(dolist (specializer specializers)
- (let* ((tagcode (funcall cl-generic-tagcode-function specializer 'arg))
+ (let* ((generalizers (cl-generic-generalizers specializer))
(x (assq i dispatches)))
(unless x
- (setq x (list i (funcall cl-generic-tagcode-function t 'arg)))
+ (setq x (cons i (cl-generic-generalizers t)))
(setf (cl--generic-dispatches generic)
(setq dispatches (cons x dispatches))))
- (unless (member tagcode (cdr x))
- (setf (cdr x)
- (nreverse (sort (cons tagcode (cdr x))
- #'car-less-than-car))))
+ (dolist (generalizer generalizers)
+ (unless (member generalizer (cdr x))
+ (setf (cdr x)
+ (sort (cons generalizer (cdr x))
+ (lambda (x y)
+ (> (cl--generic-generalizer-priority x)
+ (cl--generic-generalizer-priority y)))))))
(setq i (1+ i))))
(if me (setcar me method)
(setf (cl--generic-method-table generic) (cons method mt)))
(cl-pushnew `(cl-defmethod . (,(cl--generic-name generic) . ,specializers))
current-load-list :test #'equal)
+ ;; FIXME: Try to avoid re-constructing a new function if the old one
+ ;; is still valid (e.g. still empty method cache)?
(let ((gfun (cl--generic-make-function generic))
;; Prevent `defalias' from recording this as the definition site of
;; the generic function.
(defvar cl--generic-dispatchers (make-hash-table :test #'equal))
-(defun cl--generic-get-dispatcher (tagcodes dispatch-arg)
+(defun cl--generic-get-dispatcher (dispatch)
(cl--generic-with-memoization
- (gethash (cons dispatch-arg tagcodes) cl--generic-dispatchers)
- (let ((lexical-binding t)
- (tag-exp `(or ,@(mapcar #'cdr
- ;; Minor optimization: since this tag-exp is
- ;; only used to lookup the method-cache, it
- ;; doesn't matter if the default value is some
- ;; constant or nil.
- (if (macroexp-const-p (car (last tagcodes)))
- (butlast tagcodes)
- tagcodes))))
- (extraargs ()))
+ (gethash dispatch cl--generic-dispatchers)
+ (let* ((dispatch-arg (car dispatch))
+ (generalizers (cdr dispatch))
+ (lexical-binding t)
+ (tagcodes
+ (mapcar (lambda (generalizer)
+ (funcall (cl--generic-generalizer-tagcode-function
+ generalizer)
+ 'arg))
+ generalizers))
+ (typescodes
+ (mapcar (lambda (generalizer)
+ `(funcall ',(cl--generic-generalizer-specializers-function
+ generalizer)
+ ,(funcall (cl--generic-generalizer-tagcode-function
+ generalizer)
+ 'arg)))
+ generalizers))
+ (tag-exp
+ ;; Minor optimization: since this tag-exp is
+ ;; only used to lookup the method-cache, it
+ ;; doesn't matter if the default value is some
+ ;; constant or nil.
+ `(or ,@(if (macroexp-const-p (car (last tagcodes)))
+ (butlast tagcodes)
+ tagcodes)))
+ (extraargs ()))
(dotimes (_ dispatch-arg)
(push (make-symbol "arg") extraargs))
+ ;; FIXME: For generic functions with a single method (or with 2 methods,
+ ;; one of which always matches), using a tagcode + hash-table is
+ ;; overkill: better just use a `cl-typep' test.
(byte-compile
- `(lambda (generic dispatches-left)
+ `(lambda (generic dispatches-left methods)
(let ((method-cache (make-hash-table :test #'eql)))
(lambda (,@extraargs arg &rest args)
(apply (cl--generic-with-memoization
(gethash ,tag-exp method-cache)
(cl--generic-cache-miss
- generic ',dispatch-arg dispatches-left
- (list ,@(mapcar #'cdr tagcodes))))
+ generic ',dispatch-arg dispatches-left methods
+ ,(if (cdr typescodes)
+ `(append ,@typescodes) (car typescodes))))
,@extraargs arg args))))))))
(defun cl--generic-make-function (generic)
- (let* ((dispatches (cl--generic-dispatches generic))
- (dispatch
+ (cl--generic-make-next-function generic
+ (cl--generic-dispatches generic)
+ (cl--generic-method-table generic)))
+
+(defun cl--generic-make-next-function (generic dispatches methods)
+ (let* ((dispatch
(progn
(while (and dispatches
- (member (cdar dispatches)
- '(nil ((0 . 'cl--generic-type)))))
+ (let ((x (nth 1 (car dispatches))))
+ ;; No need to dispatch for `t' specializers.
+ (or (null x) (equal x cl--generic-t-generalizer))))
(setq dispatches (cdr dispatches)))
(pop dispatches))))
- (if (null dispatch)
- (cl--generic-build-combined-method
- (cl--generic-name generic)
- (cl--generic-method-table generic))
- (let ((dispatcher (cl--generic-get-dispatcher
- (cdr dispatch) (car dispatch))))
- (funcall dispatcher generic dispatches)))))
-
-(defvar cl-generic-method-combination-function
- #'cl--generic-standard-method-combination
- "Function to build the effective method.
-Called with 2 arguments: NAME and METHOD-ALIST.
-It should return an effective method, i.e. a function that expects the same
-arguments as the methods, and calls those methods in some appropriate order.
-NAME is the name (a symbol) of the corresponding generic function.
-METHOD-ALIST is a list of elements (QUALIFIERS . METHODS) where
-QUALIFIERS is a list of qualifiers, and METHODS is a list of the selected
-methods for that qualifier list.
-The METHODS lists are sorted from most generic first to most specific last.
-The function can use `cl-generic-call-method' to create functions that call those
-methods.")
+ (if (not (and dispatch
+ ;; If there's no method left, there's no point checking
+ ;; further arguments.
+ methods))
+ (cl--generic-build-combined-method generic methods)
+ (let ((dispatcher (cl--generic-get-dispatcher dispatch)))
+ (funcall dispatcher generic dispatches methods)))))
(defvar cl--generic-combined-method-memoization
(make-hash-table :test #'equal :weakness 'value)
of methods, since this table then allows us to share a single combined-method
for all those different tags in the method-cache.")
-(defun cl--generic-build-combined-method (generic-name methods)
- (cl--generic-with-memoization
- (gethash (cons generic-name methods)
- cl--generic-combined-method-memoization)
- (let ((mets-by-qual ()))
- (dolist (method methods)
- (let* ((qualifiers (cl--generic-method-qualifiers method))
- (x (assoc qualifiers mets-by-qual)))
- ;; FIXME: sadly, alist-get only uses `assq' and we need `assoc'.
- ;;(push (cdr qm) (alist-get qualifiers mets-by-qual)))
- (if x
- (push method (cdr x))
- (push (list qualifiers method) mets-by-qual))))
- (funcall cl-generic-method-combination-function
- generic-name mets-by-qual))))
+(define-error 'cl--generic-cyclic-definition "Cyclic definition: %S")
+
+(defun cl--generic-build-combined-method (generic methods)
+ (if (null methods)
+ ;; Special case needed to fix a circularity during bootstrap.
+ (cl--generic-standard-method-combination generic methods)
+ (let ((f
+ (cl--generic-with-memoization
+ ;; FIXME: Since the fields of `generic' are modified, this
+ ;; hash-table won't work right, because the hashes will change!
+ ;; It's not terribly serious, but reduces the effectiveness of
+ ;; the table.
+ (gethash (cons generic methods)
+ cl--generic-combined-method-memoization)
+ (puthash (cons generic methods) :cl--generic--under-construction
+ cl--generic-combined-method-memoization)
+ (condition-case nil
+ (cl-generic-combine-methods generic methods)
+ ;; Special case needed to fix a circularity during bootstrap.
+ (cl--generic-cyclic-definition
+ (cl--generic-standard-method-combination generic methods))))))
+ (if (eq f :cl--generic--under-construction)
+ (signal 'cl--generic-cyclic-definition
+ (list (cl--generic-name generic)))
+ f))))
(defun cl--generic-no-next-method-function (generic method)
(lambda (&rest args)
(apply #'cl-no-next-method generic method args)))
-(defun cl-generic-call-method (generic-name method &optional fun)
+(defun cl-generic-call-method (generic method &optional fun)
"Return a function that calls METHOD.
FUN is the function that should be called when METHOD calls
`call-next-method'."
(cl--generic-method-function method)
(let ((met-fun (cl--generic-method-function method))
(next (or fun (cl--generic-no-next-method-function
- generic-name method))))
+ generic method))))
(lambda (&rest args)
(apply met-fun
;; FIXME: This sucks: passing just `next' would
(apply next (or cnm-args args)))
args)))))
-(defun cl--generic-standard-method-combination (generic-name mets-by-qual)
- (dolist (x mets-by-qual)
- (unless (member (car x) '(() (:after) (:before) (:around)))
- (error "Unsupported qualifiers in function %S: %S" generic-name (car x))))
- (cond
- ((null mets-by-qual)
- (lambda (&rest args)
- (apply #'cl-no-applicable-method generic-name args)))
- ((null (alist-get nil mets-by-qual))
- (lambda (&rest args)
- (apply #'cl-no-primary-method generic-name args)))
- (t
- (let* ((fun nil)
- (ab-call (lambda (m) (cl-generic-call-method generic-name m)))
- (before
- (mapcar ab-call (reverse (cdr (assoc '(:before) mets-by-qual)))))
- (after (mapcar ab-call (cdr (assoc '(:after) mets-by-qual)))))
- (dolist (method (cdr (assoc nil mets-by-qual)))
- (setq fun (cl-generic-call-method generic-name method fun)))
- (when (or after before)
- (let ((next fun))
- (setq fun (lambda (&rest args)
- (dolist (bf before)
- (apply bf args))
- (prog1
- (apply next args)
- (dolist (af after)
- (apply af args)))))))
- (dolist (method (cdr (assoc '(:around) mets-by-qual)))
- (setq fun (cl-generic-call-method generic-name method fun)))
- fun))))
+;; Standard CLOS name.
+(defalias 'cl-method-qualifiers #'cl--generic-method-qualifiers)
+
+(defun cl--generic-standard-method-combination (generic methods)
+ (let ((mets-by-qual ()))
+ (dolist (method methods)
+ (let ((qualifiers (cl-method-qualifiers method)))
+ (if (eq (car qualifiers) :extra) (setq qualifiers (cddr qualifiers)))
+ (unless (member qualifiers '(() (:after) (:before) (:around)))
+ (error "Unsupported qualifiers in function %S: %S"
+ (cl--generic-name generic) qualifiers))
+ (push method (alist-get (car qualifiers) mets-by-qual))))
+ (cond
+ ((null mets-by-qual)
+ (lambda (&rest args)
+ (apply #'cl-no-applicable-method generic args)))
+ ((null (alist-get nil mets-by-qual))
+ (lambda (&rest args)
+ (apply #'cl-no-primary-method generic args)))
+ (t
+ (let* ((fun nil)
+ (ab-call (lambda (m) (cl-generic-call-method generic m)))
+ (before
+ (mapcar ab-call (reverse (cdr (assoc :before mets-by-qual)))))
+ (after (mapcar ab-call (cdr (assoc :after mets-by-qual)))))
+ (dolist (method (cdr (assoc nil mets-by-qual)))
+ (setq fun (cl-generic-call-method generic method fun)))
+ (when (or after before)
+ (let ((next fun))
+ (setq fun (lambda (&rest args)
+ (dolist (bf before)
+ (apply bf args))
+ (prog1
+ (apply next args)
+ (dolist (af after)
+ (apply af args)))))))
+ (dolist (method (cdr (assoc :around mets-by-qual)))
+ (setq fun (cl-generic-call-method generic method fun)))
+ fun)))))
+
+(defun cl--generic-cache-miss (generic
+ dispatch-arg dispatches-left methods-left types)
+ (let ((methods '()))
+ (dolist (method methods-left)
+ (let* ((specializer (or (nth dispatch-arg
+ (cl--generic-method-specializers method))
+ t))
+ (m (member specializer types)))
+ (when m
+ (push (cons (length m) method) methods))))
+ ;; Sort the methods, most specific first.
+ ;; It would be tempting to sort them once and for all in the method-table
+ ;; rather than here, but the order might depend on the actual argument
+ ;; (e.g. for multiple inheritance with defclass).
+ (setq methods (nreverse (mapcar #'cdr (sort methods #'car-less-than-car))))
+ (cl--generic-make-next-function generic dispatches-left methods)))
+
+(cl-defgeneric cl-generic-generalizers (specializer)
+ "Return a list of generalizers for a given SPECIALIZER.
+To each kind of `specializer', corresponds a `generalizer' which describes
+how to extract a \"tag\" from an object which will then let us check if this
+object matches the specializer. A typical example of a \"tag\" would be the
+type of an object. It's called a `generalizer' because it
+takes a specific object and returns a more general approximation,
+denoting a set of objects to which it belongs.
+A generalizer gives us the chunk of code which the
+dispatch function needs to use to extract the \"tag\" of an object, as well
+as a function which turns this tag into an ordered list of
+`specializers' that this object matches.
+The code which extracts the tag should be as fast as possible.
+The tags should be chosen according to the following rules:
+- The tags should not be too specific: similar objects which match the
+ same list of specializers should ideally use the same (`eql') tag.
+ This insures that the cached computation of the applicable
+ methods for one object can be reused for other objects.
+- Corollary: objects which don't match any of the relevant specializers
+ should ideally all use the same tag (typically nil).
+ This insures that this cache does not grow unnecessarily large.
+- Two different generalizers G1 and G2 should not use the same tag
+ unless they use it for the same set of objects. IOW, if G1.tag(X1) =
+ G2.tag(X2) then G1.tag(X1) = G2.tag(X1) = G1.tag(X2) = G2.tag(X2).
+- If G1.priority > G2.priority and G1.tag(X1) = G1.tag(X2) and this tag is
+ non-nil, then you have to make sure that the G2.tag(X1) = G2.tag(X2).
+ This is because the method-cache is only indexed with the first non-nil
+ tag (by order of decreasing priority).")
+
+
+(cl-defgeneric cl-generic-combine-methods (generic methods)
+ "Build the effective method made of METHODS.
+It should return a function that expects the same arguments as the methods, and
+ calls those methods in some appropriate order.
+GENERIC is the generic function (mostly used for its name).
+METHODS is the list of the selected methods.
+The METHODS list is sorted from most specific first to most generic last.
+The function can use `cl-generic-call-method' to create functions that call those
+methods.")
+
+;; Temporary definition to let the next defmethod succeed.
+(fset 'cl-generic-generalizers
+ (lambda (_specializer) (list cl--generic-t-generalizer)))
+(fset 'cl-generic-combine-methods
+ #'cl--generic-standard-method-combination)
+
+(cl-defmethod cl-generic-generalizers (specializer)
+ "Support for the catch-all `t' specializer."
+ (if (eq specializer t) (list cl--generic-t-generalizer)
+ (error "Unknown specializer %S" specializer)))
+
+(cl-defmethod cl-generic-combine-methods (generic methods)
+ "Standard support for :after, :before, :around, and `:extra NAME' qualifiers."
+ (cl--generic-standard-method-combination generic methods))
(defconst cl--generic-nnm-sample (cl--generic-no-next-method-function t t))
(defconst cl--generic-cnm-sample
(funcall (cl--generic-build-combined-method
- nil (list (cl--generic-method-make () () t #'identity)))))
+ nil (list (cl--generic-make-method () () t #'identity)))))
(defun cl--generic-isnot-nnm-p (cnm)
"Return non-nil if CNM is the function that calls `cl-no-next-method'."
(setq cnm-env (cdr cnm-env)))))
(error "Haven't found no-next-method-sample in cnm-sample")))
-(defun cl--generic-cache-miss (generic dispatch-arg dispatches-left tags)
- (let ((types (apply #'append (mapcar cl-generic-tag-types-function tags)))
- (methods '()))
- (dolist (method (cl--generic-method-table generic))
- (let* ((specializer (or (nth dispatch-arg
- (cl--generic-method-specializers method))
- t))
- (m (member specializer types)))
- (when m
- (push (cons (length m) method) methods))))
- ;; Sort the methods, most specific first.
- ;; It would be tempting to sort them once and for all in the method-table
- ;; rather than here, but the order might depend on the actual argument
- ;; (e.g. for multiple inheritance with defclass).
- (setq methods (nreverse (mapcar #'cdr (sort methods #'car-less-than-car))))
- (cl--generic-make-function (cl--generic-make (cl--generic-name generic)
- dispatches-left methods))))
-
;;; Define some pre-defined generic functions, used internally.
(define-error 'cl-no-method "No method for %S")
'cl-no-method)
(cl-defgeneric cl-no-next-method (generic method &rest args)
- "Function called when `cl-call-next-method' finds no next method.")
-(cl-defmethod cl-no-next-method (generic method &rest args)
- (signal 'cl-no-next-method `(,generic ,method ,@args)))
+ "Function called when `cl-call-next-method' finds no next method."
+ (signal 'cl-no-next-method `(,(cl--generic-name generic) ,method ,@args)))
(cl-defgeneric cl-no-applicable-method (generic &rest args)
- "Function called when a method call finds no applicable method.")
-(cl-defmethod cl-no-applicable-method (generic &rest args)
- (signal 'cl-no-applicable-method `(,generic ,@args)))
+ "Function called when a method call finds no applicable method."
+ (signal 'cl-no-applicable-method `(,(cl--generic-name generic) ,@args)))
(cl-defgeneric cl-no-primary-method (generic &rest args)
- "Function called when a method call finds no primary method.")
-(cl-defmethod cl-no-primary-method (generic &rest args)
- (signal 'cl-no-primary-method `(,generic ,@args)))
+ "Function called when a method call finds no primary method."
+ (signal 'cl-no-primary-method `(,(cl--generic-name generic) ,@args)))
(defun cl-call-next-method (&rest _args)
"Function to call the next applicable method.
(insert "'.\n")))
(insert "\n" (or (nth 2 info) "Undocumented") "\n\n")))))))
+;;; Support for (head <val>) specializers.
+
+;; For both the `eql' and the `head' specializers, the dispatch
+;; is unsatisfactory. Basically, in the "common&fast case", we end up doing
+;;
+;; (let ((tag (gethash value <tagcode-hashtable>)))
+;; (funcall (gethash tag <method-cache>)))
+;;
+;; whereas we'd like to just do
+;;
+;; (funcall (gethash value <method-cache>)))
+;;
+;; but the problem is that the method-cache is normally "open ended", so
+;; a nil means "not computed yet" and if we bump into it, we dutifully fill the
+;; corresponding entry, whereas we'd want to just fallback on some default
+;; effective method (so as not to fill the cache with lots of redundant
+;; entries).
+
+(defvar cl--generic-head-used (make-hash-table :test #'eql))
+
+(defconst cl--generic-head-generalizer
+ (cl-generic-make-generalizer
+ 80 (lambda (name) `(gethash (car-safe ,name) cl--generic-head-used))
+ (lambda (tag) (if (eq (car-safe tag) 'head) (list tag)))))
+
+(cl-defmethod cl-generic-generalizers :extra "head" (specializer)
+ "Support for the `(head VAL)' specializers."
+ ;; We have to implement `head' here using the :extra qualifier,
+ ;; since we can't use the `head' specializer to implement itself.
+ (if (not (eq (car-safe specializer) 'head))
+ (cl-call-next-method)
+ (cl--generic-with-memoization
+ (gethash (cadr specializer) cl--generic-head-used) specializer)
+ (list cl--generic-head-generalizer)))
+
;;; Support for (eql <val>) specializers.
(defvar cl--generic-eql-used (make-hash-table :test #'eql))
-(add-function :before-until cl-generic-tagcode-function
- #'cl--generic-eql-tagcode)
-(defun cl--generic-eql-tagcode (type name)
- (when (eq (car-safe type) 'eql)
- (puthash (cadr type) type cl--generic-eql-used)
- `(100 . (gethash ,name cl--generic-eql-used))))
+(defconst cl--generic-eql-generalizer
+ (cl-generic-make-generalizer
+ 100 (lambda (name) `(gethash ,name cl--generic-eql-used))
+ (lambda (tag) (if (eq (car-safe tag) 'eql) (list tag)))))
-(add-function :before-until cl-generic-tag-types-function
- #'cl--generic-eql-tag-types)
-(defun cl--generic-eql-tag-types (tag)
- (if (eq (car-safe tag) 'eql) (list tag)))
+(cl-defmethod cl-generic-generalizers ((specializer (head eql)))
+ "Support for the `(eql VAL)' specializers."
+ (puthash (cadr specializer) specializer cl--generic-eql-used)
+ (list cl--generic-eql-generalizer))
;;; Support for cl-defstructs specializers.
-(add-function :before-until cl-generic-tagcode-function
- #'cl--generic-struct-tagcode)
-
(defun cl--generic-struct-tag (name)
+ ;; It's tempting to use (and (vectorp ,name) (aref ,name 0))
+ ;; but that would suffer from some problems:
+ ;; - the vector may have size 0.
+ ;; - when called on an actual vector (rather than an object), we'd
+ ;; end up returning an arbitrary value, possibly colliding with
+ ;; other tagcode's values.
+ ;; - it can also result in returning all kinds of irrelevant
+ ;; values which would end up filling up the method-cache with
+ ;; lots of irrelevant/redundant entries.
+ ;; FIXME: We could speed this up by introducing a dedicated
+ ;; vector type at the C level, so we could do something like
+ ;; (and (vector-objectp ,name) (aref ,name 0))
`(and (vectorp ,name)
(> (length ,name) 0)
(let ((tag (aref ,name 0)))
(if (eq (symbol-function tag) :quick-object-witness-check)
tag))))
-(defun cl--generic-struct-tagcode (type name)
- (and (symbolp type)
- (get type 'cl-struct-type)
- (or (eq 'vector (car (get type 'cl-struct-type)))
- (error "Can't dispatch on cl-struct %S: type is %S"
- type (car (get type 'cl-struct-type))))
- (or (equal '(cl-tag-slot) (car (get type 'cl-struct-slots)))
- (error "Can't dispatch on cl-struct %S: no tag in slot 0"
- type))
- ;; It's tempting to use (and (vectorp ,name) (aref ,name 0))
- ;; but that would suffer from some problems:
- ;; - the vector may have size 0.
- ;; - when called on an actual vector (rather than an object), we'd
- ;; end up returning an arbitrary value, possibly colliding with
- ;; other tagcode's values.
- ;; - it can also result in returning all kinds of irrelevant
- ;; values which would end up filling up the method-cache with
- ;; lots of irrelevant/redundant entries.
- ;; FIXME: We could speed this up by introducing a dedicated
- ;; vector type at the C level, so we could do something like
- ;; (and (vector-objectp ,name) (aref ,name 0))
- `(50 . ,(cl--generic-struct-tag name))))
-
-(add-function :before-until cl-generic-tag-types-function
- #'cl--generic-struct-tag-types)
-(defun cl--generic-struct-tag-types (tag)
- ;; FIXME: cl-defstruct doesn't make it easy for us.
- (and (symbolp tag)
- ;; A method call shouldn't itself mess with the match-data.
- (string-match-p "\\`cl-struct-\\(.*\\)" (symbol-name tag))
- (let ((types (list (intern (substring (symbol-name tag) 10)))))
- (while (get (car types) 'cl-struct-include)
- (push (get (car types) 'cl-struct-include) types))
- (push 'cl-struct types) ;The "parent type" of all cl-structs.
- (nreverse types))))
+(defun cl--generic-struct-specializers (tag)
+ (and (symbolp tag) (boundp tag)
+ (let ((class (symbol-value tag)))
+ (when (cl-typep class 'cl-structure-class)
+ (let ((types ())
+ (classes (list class)))
+ ;; BFS precedence.
+ (while (let ((class (pop classes)))
+ (push (cl--class-name class) types)
+ (setq classes
+ (append classes
+ (cl--class-parents class)))))
+ (nreverse types))))))
+
+(defconst cl--generic-struct-generalizer
+ (cl-generic-make-generalizer
+ 50 #'cl--generic-struct-tag
+ #'cl--generic-struct-specializers))
+
+(cl-defmethod cl-generic-generalizers :extra "cl-struct" (type)
+ "Support for dispatch on cl-struct types."
+ (or
+ (when (symbolp type)
+ ;; Use the "cl--struct-class*" (inlinable) functions/macros rather than
+ ;; the "cl-struct-*" variants which aren't inlined, so that dispatch can
+ ;; take place without requiring cl-lib.
+ (let ((class (cl--find-class type)))
+ (and (cl-typep class 'cl-structure-class)
+ (or (null (cl--struct-class-type class))
+ (error "Can't dispatch on cl-struct %S: type is %S"
+ type (cl--struct-class-type class)))
+ (progn (cl-assert (null (cl--struct-class-named class))) t)
+ (list cl--generic-struct-generalizer))))
+ (cl-call-next-method)))
;;; Dispatch on "system types".
(sequence)
(number)))
-(add-function :before-until cl-generic-tagcode-function
- #'cl--generic-typeof-tagcode)
-(defun cl--generic-typeof-tagcode (type name)
+(defconst cl--generic-typeof-generalizer
+ (cl-generic-make-generalizer
+ ;; FIXME: We could also change `type-of' to return `null' for nil.
+ 10 (lambda (name) `(if ,name (type-of ,name) 'null))
+ (lambda (tag) (and (symbolp tag) (assq tag cl--generic-typeof-types)))))
+
+(cl-defmethod cl-generic-generalizers :extra "typeof" (type)
+ "Support for dispatch on builtin types."
;; FIXME: Add support for other types accepted by `cl-typep' such
;; as `character', `atom', `face', `function', ...
- (and (assq type cl--generic-typeof-types)
- (progn
- (if (memq type '(vector array sequence))
- (message "`%S' also matches CL structs and EIEIO classes" type))
- ;; FIXME: We could also change `type-of' to return `null' for nil.
- `(10 . (if ,name (type-of ,name) 'null)))))
-
-(add-function :before-until cl-generic-tag-types-function
- #'cl--generic-typeof-types)
-(defun cl--generic-typeof-types (tag)
- (and (symbolp tag)
- (assq tag cl--generic-typeof-types)))
+ (or
+ (and (assq type cl--generic-typeof-types)
+ (progn
+ (if (memq type '(vector array sequence))
+ (message "`%S' also matches CL structs and EIEIO classes" type))
+ (list cl--generic-typeof-generalizer)))
+ (cl-call-next-method)))
;;; Just for kicks: dispatch on major-mode
;;
;; (defvar cl--generic-major-modes (make-hash-table :test #'eq))
;;
-;; (add-function :before-until cl-generic-tagcode-function
+;; (add-function :before-until cl-generic-generalizer-function
;; #'cl--generic-major-mode-tagcode)
;; (defun cl--generic-major-mode-tagcode (type name)
;; (if (eq 'major-mode (car-safe type))
:type 'boolean
:group 'lisp-indent)
+(defcustom lisp-indent-backquote-substitution-mode t
+ "How to indent substitutions in backquotes.
+If `t', the default, indent substituted forms normally.
+If `nil', do not apply special indentation rule to substituted
+forms. If `corrected', subtract the `,' or `,@' from the form
+column, indenting as if this character sequence were not present.
+In any case, do not backtrack beyond a backquote substitution.
+
+Until Emacs 25.1, the `nil' behavior was hard-wired."
+ :version "25.1"
+ :type '(choice (const corrected) (const nil) (const t))
+ :group 'lisp-indent)
+
\f
(defvar lisp-indent-defun-method '(4 &lambda &body)
"Defun-like indentation method.
is set to `defun'.")
-(defun extended-loop-p (loop-start)
+(defun lisp-extended-loop-p (loop-start)
"True if an extended loop form starts at LOOP-START."
(condition-case ()
(save-excursion
"Compute the indentation of loop form constituents."
(let* ((loop-indentation (save-excursion
(goto-char (elt state 1))
- (current-column))))
+ (current-column))))
+ (when (and (eq lisp-indent-backquote-substitution-mode 'corrected))
+ (save-excursion
+ (goto-char (elt state 1))
+ (incf loop-indentation
+ (cond ((eq (char-before) ?,) -1)
+ ((and (eq (char-before) ?@)
+ (progn (backward-char)
+ (eq (char-before) ?,)))
+ -2)
+ (t 0)))))
+
(goto-char indent-point)
(beginning-of-line)
(list
- (cond ((not (extended-loop-p (elt state 1)))
+ (cond ((not (lisp-extended-loop-p (elt state 1)))
(+ loop-indentation lisp-simple-loop-indentation))
((looking-at "^\\s-*\\(:?\\sw+\\|;\\)")
(+ loop-indentation lisp-loop-keyword-indentation))
instead."
;; FIXME: why do we need to special-case loop?
(if (save-excursion (goto-char (elt state 1))
- (looking-at (if (derived-mode-p 'emacs-lisp-mode)
- "(\\(cl-\\)?[Ll][Oo][Oo][Pp]"
- "([Ll][Oo][Oo][Pp]")))
+ (and (looking-at (if (derived-mode-p 'emacs-lisp-mode)
+ "(\\(cl-\\)?loop"
+ "([Ll][Oo][Oo][Pp]"))
+ (or lisp-indent-backquote-substitution-mode
+ (not
+ (or (and (eq (char-before) ?@)
+ (progn (backward-char)
+ (eq (char-before) ?,)))
+ (eq (char-before) ?,))))))
(common-lisp-loop-part-indentation indent-point state)
(common-lisp-indent-function-1 indent-point state)))
(not (eq (char-after (- containing-sexp 2)) ?\#)))
;; No indentation for "'(...)" elements
(setq calculated (1+ sexp-column)))
- ((or (eq (char-after (1- containing-sexp)) ?\,)
- (and (eq (char-after (1- containing-sexp)) ?\@)
- (eq (char-after (- containing-sexp 2)) ?\,)))
- ;; ",(...)" or ",@(...)"
- (setq calculated normal-indent))
+ ((when
+ (or (eq (char-after (1- containing-sexp)) ?\,)
+ (and (eq (char-after (1- containing-sexp)) ?\@)
+ (eq (char-after (- containing-sexp 2)) ?\,)))
+ ;; ",(...)" or ",@(...)"
+ (when (eq lisp-indent-backquote-substitution-mode
+ 'corrected)
+ (incf sexp-column -1)
+ (when (eq (char-after (1- containing-sexp)) ?\@)
+ (incf sexp-column -1)))
+ (cond (lisp-indent-backquote-substitution-mode
+ (setf tentative-calculated normal-indent)
+ (setq depth lisp-indent-maximum-backtracking)
+ nil)
+ (t (setq calculated normal-indent)))))
((eq (char-after (1- containing-sexp)) ?\#)
;; "#(...)"
(setq calculated (1+ sexp-column)))
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)
;;; Miscellaneous.
-;;;###autoload
-(progn
- ;; The `assert' macro from the cl package signals
- ;; `cl-assertion-failed' at runtime so always define it.
- (define-error 'cl-assertion-failed (purecopy "Assertion failed"))
- ;; Make sure functions defined with cl-defsubst can be inlined even in
- ;; packages which do not require CL. We don't put an autoload cookie
- ;; directly on that function, since those cookies only go to cl-loaddefs.
- (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))
-
(provide 'cl-lib)
(or (load "cl-loaddefs" 'noerror 'quiet)
;; When bootstrapping, cl-loaddefs hasn't been built yet!
(defconst cl--lambda-list-keywords
'(&optional &rest &key &allow-other-keys &aux &whole &body &environment))
-(defvar cl--bind-block) (defvar cl--bind-defs) (defvar cl--bind-enquote)
+;; Internal hacks used in formal arg lists:
+;; - &cl-quote: Added to formal-arglists to mean that any default value
+;; mentioned in the formal arglist should be considered as implicitly
+;; quoted rather than evaluated. This is used in `cl-defsubst' when
+;; performing compiler-macro-expansion, since at that time the
+;; arguments hold expressions rather than values.
+;; - &cl-defs (DEF . DEFS): Gives the default value to use for missing
+;; optional arguments which don't have an explicit default value.
+;; DEFS is an alist mapping vars to their default default value.
+;; and DEF is the default default to use for all other vars.
+
+(defvar cl--bind-block) ;Name of surrounding block, only use for `signal' data.
+(defvar cl--bind-defs) ;(DEF . DEFS) giving the "default default" for optargs.
+(defvar cl--bind-enquote) ;Non-nil if &cl-quote was in the formal arglist!
(defvar cl--bind-lets) (defvar cl--bind-forms)
(defun cl--transform-lambda (form bind-block)
and which will be used for the name of the `cl-block' surrounding the
function's body.
FORM is of the form (ARGS . BODY)."
- ;; FIXME: (lambda (a &aux b) 1) expands to (lambda (a &rest --cl-rest--) ...)
- ;; where the --cl-rest-- is clearly undesired.
(let* ((args (car form)) (body (cdr form)) (orig-args args)
(cl--bind-block bind-block) (cl--bind-defs nil) (cl--bind-enquote 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 cl-declare)))
- (push (pop body) header))
+ (parsed-body (macroexp-parse-body body))
+ (header (car parsed-body)) (simple-args nil))
+ (setq body (cdr parsed-body))
+ ;; "(. X) to (&rest X)" conversion already done in cl--do-arglist, but we
+ ;; do it here as well, so as to be able to see if we can avoid
+ ;; cl--do-arglist.
(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 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)))
+ (let ((cl-defs (memq '&cl-defs args)))
+ (when cl-defs
+ (setq cl--bind-defs (cadr cl-defs))
+ ;; Remove "&cl-defs DEFS" from args.
+ (setcdr cl-defs (cddr cl-defs))
+ (setq args (delq '&cl-defs args))))
(if (setq cl--bind-enquote (memq '&cl-quote args))
(setq args (delq '&cl-quote args)))
(if (memq '&whole args) (error "&whole not currently implemented"))
(v (cadr p)))
(if p (setq args (nconc (delq (car p) (delq v args))
`(&aux (,v macroexpand-all-environment))))))
- (while (and args (symbolp (car args))
- (not (memq (car args) '(nil &rest &body &key &aux)))
- (not (and (eq (car args) '&optional)
- (or cl--bind-defs (consp (cadr args))))))
- (push (pop args) simple-args))
+ ;; Take away all the simple args whose parsing can be handled more
+ ;; efficiently by a plain old `lambda' than the manual parsing generated
+ ;; by `cl--do-arglist'.
+ (let ((optional nil))
+ (while (and args (symbolp (car args))
+ (not (memq (car args) '(nil &rest &body &key &aux)))
+ (or (not optional)
+ ;; Optional args whose default is nil are simple.
+ (null (nth 1 (assq (car args) (cdr cl--bind-defs)))))
+ (not (and (eq (car args) '&optional) (setq optional t)
+ (car cl--bind-defs))))
+ (push (pop args) simple-args))
+ (when optional
+ (if args (push '&optional args))
+ ;; Don't keep a dummy trailing &optional without actual optional args.
+ (if (eq '&optional (car simple-args)) (pop simple-args))))
(or (eq cl--bind-block 'cl-none)
(setq body (list `(cl-block ,cl--bind-block ,@body))))
- (if (null args)
- (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 cl--bind-lets (nreverse cl--bind-lets))
- (cl-list* nil
- (nconc (nreverse simple-args)
- (list '&rest (car (pop cl--bind-lets))))
- (nconc (let ((hdr (nreverse header)))
+ (let* ((cl--bind-lets nil) (cl--bind-forms nil)
+ (rest-args
+ (cond
+ ((null args) nil)
+ ((eq (car args) '&aux)
+ (cl--do-&aux args)
+ (setq cl--bind-lets (nreverse cl--bind-lets))
+ nil)
+ (t ;; `simple-args' doesn't handle all the parsing that we need,
+ ;; so we pass the rest to cl--do-arglist which will do
+ ;; "manual" parsing.
+ (let ((slen (length simple-args)))
+ (when (memq '&optional simple-args)
+ (cl-decf slen))
+ (setq header
;; Macro expansion can take place in the middle of
;; apparently harmless computation, so it should not
;; touch the match-data.
(save-match-data
(require 'help-fns)
(cons (help-add-fundoc-usage
- (if (stringp (car hdr)) (pop hdr))
+ (if (stringp (car header)) (pop header))
;; Be careful with make-symbol and (back)quote,
;; see bug#12884.
(let ((print-gensym nil) (print-quoted t))
(format "%S" (cons 'fn (cl--make-usage-args
orig-args)))))
- hdr)))
- (list `(let* ,cl--bind-lets
- ,@(nreverse cl--bind-forms)
- ,@body)))))))
+ header)))
+ ;; FIXME: we'd want to choose an arg name for the &rest param
+ ;; and pass that as `expr' to cl--do-arglist, but that ends up
+ ;; generating code with a redundant let-binding, so we instead
+ ;; pass a dummy and then look in cl--bind-lets to find what var
+ ;; this was bound to.
+ (cl--do-arglist args :dummy slen)
+ (setq cl--bind-lets (nreverse cl--bind-lets))
+ ;; (cl-assert (eq :dummy (nth 1 (car cl--bind-lets))))
+ (list '&rest (car (pop cl--bind-lets))))))))
+ `(nil
+ (,@(nreverse simple-args) ,@rest-args)
+ ,@header
+ ,(macroexp-let* cl--bind-lets
+ (macroexp-progn
+ `(,@(nreverse cl--bind-forms)
+ ,@body)))))))
;;;###autoload
(defmacro cl-defun (name args &rest body)
(form `(defun ,name ,@(cdr res))))
(if (car res) `(progn ,(car res) ,form) form)))
+;;;###autoload
+(defmacro cl-iter-defun (name args &rest body)
+ "Define NAME as a generator function.
+Like normal `iter-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 iter-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))
+ (require 'generator)
+ (let* ((res (cl--transform-lambda (cons args body) name))
+ (form `(iter-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.
(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.
+ ;; `orig-args' can contain &cl-defs.
(let ((x (memq '&cl-defs arglist)))
(when x (setq arglist (delq (car x) (remq (cadr x) arglist)))))
(let ((state nil))
))))
arglist))))
+(defun cl--do-&aux (args)
+ (while (and (eq (car args) '&aux) (pop args))
+ (while (and args (not (memq (car args) cl--lambda-list-keywords)))
+ (if (consp (car args))
+ (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 ends with: %S" args)))
+
(defun cl--do-arglist (args expr &optional num) ; uses cl--bind-*
(if (nlistp args)
(if (or (memq args cl--lambda-list-keywords) (not (symbolp 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))
+ (let ((restarg (memq '&rest args))
(safety (if (cl--compiling-file) cl--optimize-safety 3))
(keys nil)
(laterarg nil) (exactarg nil) minarg)
(intern (format ":%s" name)))))
(varg (if (consp (car arg)) (cl-cadar arg) (car arg)))
(def (if (cdr arg) (cadr arg)
- (or (car cl--bind-defs) (cadr (assq varg cl--bind-defs)))))
+ ;; The ordering between those two or clauses is
+ ;; irrelevant, since in practice only one of the two
+ ;; is ever non-nil (the car is only used for
+ ;; cl-deftype which doesn't use the cdr).
+ (or (car cl--bind-defs)
+ (cadr (assq varg cl--bind-defs)))))
(look `(plist-member ,restarg ',karg)))
(and def cl--bind-enquote (setq def `',def))
(if (cddr arg)
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) cl--lambda-list-keywords)))
- (if (consp (car args))
- (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)))))
+ (cl--do-&aux args)
+ nil)))
(defun cl--arglist-args (args)
(if (nlistp args) (list args)
(declare (debug ((symbolp form &optional form) cl-declarations body))
(indent 1))
(let ((loop `(dolist ,spec ,@body)))
- (if (advice-member-p #'cl--wrap-in-nil-block 'dolist)
+ (if (advice-member-p 'cl--wrap-in-nil-block 'dolist)
loop `(cl-block nil ,loop))))
;;;###autoload
\(fn (VAR COUNT [RESULT]) BODY...)"
(declare (debug cl-dolist) (indent 1))
(let ((loop `(dotimes ,spec ,@body)))
- (if (advice-member-p #'cl--wrap-in-nil-block 'dotimes)
+ (if (advice-member-p 'cl--wrap-in-nil-block 'dotimes)
loop `(cl-block nil ,loop))))
(defvar cl--tagbody-alist nil)
(if (symbolp func) (cons func rargs)
`(funcall #',func ,@rargs))))))))
+;;;###autoload
+(defmacro cl-defsubst (name args &rest body)
+ "Define NAME as a function.
+Like `defun', except the function is automatically declared `inline' and
+the arguments are immutable.
+ARGLIST allows full Common Lisp conventions, and BODY is implicitly
+surrounded by (cl-block NAME ...).
+The function's arguments should be treated as immutable.
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)"
+ (declare (debug cl-defun) (indent 2))
+ (let* ((argns (cl--arglist-args args))
+ (real-args (if (eq '&cl-defs (car args)) (cddr args) args))
+ (p argns)
+ ;; (pbody (cons 'progn body))
+ )
+ (while (and p (eq (cl--expr-contains real-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) nil ,@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
+ (cl-mapcar (lambda (argn argv)
+ (if (or simple (macroexp-const-p argv))
+ (progn (push (cons argn argv) substs)
+ nil)
+ (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.
+ ;; FIXME: `sublis/subst' will happily copy `argv' to a different
+ ;; scope, leading to name capture.
+ (setq body (cond ((null substs) body)
+ ((null (cdr substs))
+ (cl-subst (cdar substs) (caar substs) body))
+ (t (cl--sublis substs body))))
+ (if lets `(let ,lets ,body) body))))
+
+(defun cl--sublis (alist tree)
+ "Perform substitutions indicated by ALIST in TREE (non-destructively)."
+ (let ((x (assq tree alist)))
+ (cond
+ (x (cdr x))
+ ((consp tree)
+ (cons (cl--sublis alist (car tree)) (cl--sublis alist (cdr tree))))
+ (t tree))))
+
;;; Structures.
+(defmacro cl--find-class (type)
+ `(get ,type 'cl--class))
+
+;; Rather than hard code cl-structure-object, we indirect through this variable
+;; for bootstrapping reasons.
+(defvar cl--struct-default-parent nil)
+
;;;###autoload
(defmacro cl-defstruct (struct &rest descs)
"Define a struct type.
(tag (intern (format "cl-struct-%s" name)))
(tag-symbol (intern (format "cl-struct-%s-tags" name)))
(include-descs nil)
+ (include-name nil)
(type nil)
(named nil)
(forms nil)
((eq opt :predicate)
(if args (setq predicate (car args))))
((eq opt :include)
- (when include (error "Can't :include more than once"))
- (setq include (car args)
- include-descs (mapcar (function
- (lambda (x)
- (if (consp x) x (list x))))
- (cdr args))))
+ ;; FIXME: Actually, we can include more than once as long as
+ ;; we include EIEIO classes rather than cl-structs!
+ (when include-name (error "Can't :include more than once"))
+ (setq include-name (car args))
+ (setq include-descs (mapcar (function
+ (lambda (x)
+ (if (consp x) x (list x))))
+ (cdr args))))
((eq opt :print-function)
(setq print-func (car args)))
((eq opt :type)
descs)))
(t
(error "Slot option %s unrecognized" opt)))))
+ (unless (or include-name type)
+ (setq include-name cl--struct-default-parent))
+ (when include-name (setq include (cl--struct-get-class include-name)))
(if print-func
(setq print-func
`(progn (funcall #',print-func cl-x cl-s cl-n) t))
- (or type (and include (not (get include 'cl-struct-print)))
+ (or type (and include (not (cl--struct-class-print include)))
(setq print-auto t
print-func (and (or (not (or include type)) (null print-func))
`(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)))
- (or inc-type (error "%s is not a struct name" include))
- (and type (not (eq (car inc-type) type))
+ (let* ((inc-type (cl--struct-class-type include))
+ (old-descs (cl-struct-slot-info include)))
+ (and type (not (eq inc-type type))
(error ":type disagrees with :include for %s" name))
(while include-descs
(setcar (memq (or (assq (caar include-descs) old-descs)
old-descs)
(pop include-descs)))
(setq descs (append old-descs (delq (assq 'cl-tag-slot descs) descs))
- type (car inc-type)
- named (assq 'cl-tag-slot descs))
- (if (cadr inc-type) (setq tag name named t))
- (let ((incl include))
- (while incl
- (push `(cl-pushnew ',tag
- ,(intern (format "cl-struct-%s-tags" incl)))
- forms)
- (setq incl (get incl 'cl-struct-include)))))
+ type inc-type
+ named (if type (assq 'cl-tag-slot descs) 'true))
+ (if (cl--struct-class-named include) (setq tag name named t)))
(if type
(progn
(or (memq type '(vector list))
(error "Invalid :type specifier: %s" type))
(if named (setq tag name)))
- (setq type 'vector named 'true)))
+ (setq named 'true)))
(or named (setq descs (delq (assq 'cl-tag-slot descs) descs)))
(when (and (null predicate) named)
(setq predicate (intern (format "cl--struct-%s-p" name))))
(length (memq (assq 'cl-tag-slot descs)
descs)))))
(cond
- ((eq type 'vector)
+ ((memq type '(nil vector))
`(and (vectorp cl-x)
(>= (length cl-x) ,(length descs))
(memq (aref cl-x ,pos) ,tag-symbol)))
(declare (side-effect-free t))
,@(and pred-check
(list `(or ,pred-check
- (error "%s accessing a non-%s"
- ',accessor ',name))))
- ,(if (eq type 'vector) `(aref cl-x ,pos)
+ (signal 'wrong-type-argument
+ (list ',name cl-x)))))
+ ,(if (memq type '(nil vector)) `(aref cl-x ,pos)
(if (= pos 0) '(car cl-x)
`(nth ,pos cl-x))))
forms)
(make (cl-mapcar (function (lambda (s d) (if (memq s anames) s d)))
slots defaults)))
(push `(cl-defsubst ,name
- (&cl-defs '(nil ,@descs) ,@args)
+ (&cl-defs (nil ,@descs) ,@args)
,@(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
'((declare (side-effect-free t))))
- (,type ,@make))
+ (,(or type #'vector) ,@make))
forms)))
(if print-auto (nconc print-func (list '(princ ")" cl-s) t)))
;; Don't bother adding to cl-custom-print-functions since it's not used
`(progn
(defvar ,tag-symbol)
,@(nreverse forms)
+ ;; Call cl-struct-define during compilation as well, so that
+ ;; a subsequent cl-defstruct in the same file can correctly include this
+ ;; struct as a parent.
(eval-and-compile
- (cl-struct-define ',name ,docstring ',include
+ (cl-struct-define ',name ,docstring ',include-name
',type ,(eq named t) ',descs ',tag-symbol ',tag
',print-auto))
',name)))
+;;; Add cl-struct support to pcase
+
+(defun cl--struct-all-parents (class)
+ (when (cl--struct-class-p class)
+ (let ((res ())
+ (classes (list class)))
+ ;; BFS precedence.
+ (while (let ((class (pop classes)))
+ (push class res)
+ (setq classes
+ (append classes
+ (cl--class-parents class)))))
+ (nreverse res))))
+
+;;;###autoload
+(pcase-defmacro cl-struct (type &rest fields)
+ "Pcase patterns to match cl-structs.
+Elements of FIELDS can be of the form (NAME UPAT) in which case the contents of
+field NAME is matched against UPAT, or they can be of the form NAME which
+is a shorthand for (NAME NAME)."
+ `(and (pred (pcase--flip cl-typep ',type))
+ ,@(mapcar
+ (lambda (field)
+ (let* ((name (if (consp field) (car field) field))
+ (pat (if (consp field) (cadr field) field)))
+ `(app ,(if (eq (cl-struct-sequence-type type) 'list)
+ `(nth ,(cl-struct-slot-offset type name))
+ `(pcase--flip aref ,(cl-struct-slot-offset type name)))
+ ,pat)))
+ fields)))
+
+(defun cl--pcase-mutually-exclusive-p (orig pred1 pred2)
+ "Extra special cases for `cl-typep' predicates."
+ (let* ((x1 pred1) (x2 pred2)
+ (t1
+ (and (eq 'pcase--flip (car-safe x1)) (setq x1 (cdr x1))
+ (eq 'cl-typep (car-safe x1)) (setq x1 (cdr x1))
+ (null (cdr-safe x1)) (setq x1 (car x1))
+ (eq 'quote (car-safe x1)) (cadr x1)))
+ (t2
+ (and (eq 'pcase--flip (car-safe x2)) (setq x2 (cdr x2))
+ (eq 'cl-typep (car-safe x2)) (setq x2 (cdr x2))
+ (null (cdr-safe x2)) (setq x2 (car x2))
+ (eq 'quote (car-safe x2)) (cadr x2))))
+ (or
+ (and (symbolp t1) (symbolp t2)
+ (let ((c1 (cl--find-class t1))
+ (c2 (cl--find-class t2)))
+ (and c1 c2
+ (not (or (memq c1 (cl--struct-all-parents c2))
+ (memq c2 (cl--struct-all-parents c1)))))))
+ (let ((c1 (and (symbolp t1) (cl--find-class t1))))
+ (and c1 (cl--struct-class-p c1)
+ (funcall orig (if (eq 'list (cl-struct-sequence-type t1))
+ 'consp 'vectorp)
+ pred2)))
+ (let ((c2 (and (symbolp t2) (cl--find-class t2))))
+ (and c2 (cl--struct-class-p c2)
+ (funcall orig pred1
+ (if (eq 'list (cl-struct-sequence-type t2))
+ 'consp 'vectorp))))
+ (funcall orig pred1 pred2))))
+(advice-add 'pcase--mutually-exclusive-p
+ :around #'cl--pcase-mutually-exclusive-p)
+
+
(defun cl-struct-sequence-type (struct-type)
"Return the sequence used to build STRUCT-TYPE.
STRUCT-TYPE is a symbol naming a struct type. Return 'vector or
'list, or nil if STRUCT-TYPE is not a struct type. "
(declare (side-effect-free t) (pure t))
- (car (get struct-type 'cl-struct-type)))
+ (cl--struct-class-type (cl--struct-get-class struct-type)))
(defun cl-struct-slot-info (struct-type)
"Return a list of slot names of struct STRUCT-TYPE.
`cl-defstruct'. Dummy slots that represent the struct name and
slots skipped by :initial-offset may appear in the list."
(declare (side-effect-free t) (pure t))
- (get struct-type 'cl-struct-slots))
+ (let* ((class (cl--struct-get-class struct-type))
+ (slots (cl--struct-class-slots class))
+ (type (cl--struct-class-type class))
+ (descs (if type () (list '(cl-tag-slot)))))
+ (dotimes (i (length slots))
+ (let ((slot (aref slots i)))
+ (push `(,(cl--slot-descriptor-name slot)
+ ,(cl--slot-descriptor-initform slot)
+ ,@(if (not (eq (cl--slot-descriptor-type slot) t))
+ `(:type ,(cl--slot-descriptor-type slot)))
+ ,@(cl--slot-descriptor-props slot))
+ descs)))
+ (nreverse descs)))
(defun cl-struct-slot-offset (struct-type slot-name)
"Return the offset of slot SLOT-NAME in STRUCT-TYPE.
and :initial-offset slots. Signal error if struct STRUCT-TYPE
does not contain SLOT-NAME."
(declare (side-effect-free t) (pure t))
- (or (cl-position slot-name
- (cl-struct-slot-info struct-type)
- :key #'car :test #'eq)
+ (or (gethash slot-name
+ (cl--class-index-table (cl--struct-get-class struct-type)))
(error "struct %s has no slot %s" struct-type slot-name)))
(defvar byte-compile-function-environment)
(or (cdr (assq sym byte-compile-function-environment))
(cdr (assq sym byte-compile-macro-environment))))))
-(defun cl--make-type-test (val type)
- (pcase type
- ((and `(,name . ,args) (guard (get name 'cl-deftype-handler)))
- (cl--make-type-test val (apply (get name 'cl-deftype-handler)
- args)))
- (`(,(and name (or 'integer 'float 'real 'number))
- . ,(or `(,min ,max) pcase--dontcare))
- `(and ,(cl--make-type-test val name)
- ,(if (memq min '(* nil)) t
- (if (consp min) `(> ,val ,(car min))
- `(>= ,val ,min)))
- ,(if (memq max '(* nil)) t
- (if (consp max)
- `(< ,val ,(car max))
- `(<= ,val ,max)))))
- (`(,(and name (or 'and 'or 'not)) . ,args)
- (cons name (mapcar (lambda (x) (cl--make-type-test val x)) args)))
- (`(member . ,args)
- `(and (cl-member ,val ',args) t))
- (`(satisfies ,pred) `(funcall #',pred ,val))
- ((and (pred symbolp) (guard (get type 'cl-deftype-handler)))
- (cl--make-type-test val (funcall (get type 'cl-deftype-handler))))
- ((and (pred symbolp) (guard (get type 'cl-deftype-satisfies)))
- `(funcall #',(get type 'cl-deftype-satisfies) ,val))
- ((or 'nil 't) type)
- ('null `(null ,val))
- ('atom `(atom ,val))
- ('float `(floatp ,val))
- ('real `(numberp ,val))
- ('fixnum `(integerp ,val))
- ;; FIXME: Implement `base-char' and `extended-char'.
- ('character `(characterp ,val))
- ((pred symbolp)
- (let* ((name (symbol-name type))
- (namep (intern (concat name "p"))))
- (cond
- ((cl--macroexp-fboundp namep) (list namep val))
- ((cl--macroexp-fboundp
- (setq namep (intern (concat name "-p"))))
- (list namep val))
- ((cl--macroexp-fboundp type) (list type val))
- (t (error "Unknown type %S" type)))))
- (_ (error "Bad type spec: %s" type))))
-
-(defvar cl--object)
+(put 'null 'cl-deftype-satisfies #'null)
+(put 'atom 'cl-deftype-satisfies #'atom)
+(put 'real 'cl-deftype-satisfies #'numberp)
+(put 'fixnum 'cl-deftype-satisfies #'integerp)
+(put 'base-char 'cl-deftype-satisfies #'characterp)
+(put 'character 'cl-deftype-satisfies #'integerp)
+
+
;;;###autoload
-(defun cl-typep (object type) ; See compiler macro below.
- "Check that OBJECT is of type TYPE.
-TYPE is a Common Lisp-style type specifier."
- (declare (compiler-macro cl--compiler-macro-typep))
- (let ((cl--object object)) ;; Yuck!!
- (eval (cl--make-type-test 'cl--object type))))
-
-(defun cl--compiler-macro-typep (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))
+(define-inline cl-typep (val type)
+ (inline-letevals (val)
+ (pcase (inline-const-val type)
+ ((and `(,name . ,args) (guard (get name 'cl-deftype-handler)))
+ (inline-quote
+ (cl-typep ,val ',(apply (get name 'cl-deftype-handler) args))))
+ (`(,(and name (or 'integer 'float 'real 'number))
+ . ,(or `(,min ,max) pcase--dontcare))
+ (inline-quote
+ (and (cl-typep ,val ',name)
+ ,(if (memq min '(* nil)) t
+ (if (consp min)
+ (inline-quote (> ,val ',(car min)))
+ (inline-quote (>= ,val ',min))))
+ ,(if (memq max '(* nil)) t
+ (if (consp max)
+ (inline-quote (< ,val ',(car max)))
+ (inline-quote (<= ,val ',max)))))))
+ (`(not ,type) (inline-quote (not (cl-typep ,val ',type))))
+ (`(,(and name (or 'and 'or)) . ,types)
+ (cond
+ ((null types) (inline-quote ',(eq name 'and)))
+ ((null (cdr types))
+ (inline-quote (cl-typep ,val ',(car types))))
+ (t
+ (let ((head (car types))
+ (rest `(,name . ,(cdr types))))
+ (cond
+ ((eq name 'and)
+ (inline-quote (and (cl-typep ,val ',head)
+ (cl-typep ,val ',rest))))
+ (t
+ (inline-quote (or (cl-typep ,val ',head)
+ (cl-typep ,val ',rest)))))))))
+ (`(eql ,v) (inline-quote (and (eql ,val ',v) t)))
+ (`(member . ,args) (inline-quote (and (memql ,val ',args) t)))
+ (`(satisfies ,pred) (inline-quote (funcall #',pred ,val)))
+ ((and (pred symbolp) type (guard (get type 'cl-deftype-handler)))
+ (inline-quote
+ (cl-typep ,val ',(funcall (get type 'cl-deftype-handler)))))
+ ((and (pred symbolp) type (guard (get type 'cl-deftype-satisfies)))
+ (inline-quote (funcall #',(get type 'cl-deftype-satisfies) ,val)))
+ ((and (or 'nil 't) type) (inline-quote ',type))
+ ((and (pred symbolp) type)
+ (let* ((name (symbol-name type))
+ (namep (intern (concat name "p"))))
+ (cond
+ ((cl--macroexp-fboundp namep) (inline-quote (funcall #',namep ,val)))
+ ((cl--macroexp-fboundp
+ (setq namep (intern (concat name "-p"))))
+ (inline-quote (funcall #',namep ,val)))
+ ((cl--macroexp-fboundp type) (inline-quote (funcall #',type ,val)))
+ (t (error "Unknown type %S" type)))))
+ (type (error "Bad type spec: %s" type)))))
+
;;;###autoload
(defmacro cl-check-type (form type &optional string)
(cdr form))))))
`(progn
(or ,form
- ,(if string
- `(error ,string ,@sargs ,@args)
- `(signal 'cl-assertion-failed
- (list ',form ,@sargs))))
+ (cl--assertion-failed
+ ',form ,@(if (or string sargs args)
+ `(,string (list ,@sargs) (list ,@args)))))
nil))))
;;; Compiler macros.
(if cl-found (setcdr cl-found t)))
`(throw ,cl-tag ,cl-value))
-;;;###autoload
-(defmacro cl-defsubst (name args &rest body)
- "Define NAME as a function.
-Like `defun', except the function is automatically declared `inline' and
-the arguments are immutable.
-ARGLIST allows full Common Lisp conventions, and BODY is implicitly
-surrounded by (cl-block NAME ...).
-The function's arguments should be treated as immutable.
-
-\(fn NAME ARGLIST [DOCSTRING] BODY...)"
- (declare (debug cl-defun) (indent 2))
- (let* ((argns (cl--arglist-args args))
- (p argns)
- ;; (pbody (cons 'progn body))
- )
- (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) nil ,@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
- (cl-mapcar (lambda (argn argv)
- (if (or simple (macroexp-const-p argv))
- (progn (push (cons argn argv) substs)
- nil)
- (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.
- ;; FIXME: `sublis/subst' will happily copy `argv' to a different
- ;; scope, leading to name capture.
- (setq body (cond ((null substs) body)
- ((null (cdr substs))
- (cl-subst (cdar substs) (caar substs) body))
- (t (cl--sublis substs body))))
- (if lets `(let ,lets ,body) body))))
-
-(defun cl--sublis (alist tree)
- "Perform substitutions indicated by ALIST in TREE (non-destructively)."
- (let ((x (assq tree alist)))
- (cond
- (x (cdr x))
- ((consp tree)
- (cons (cl--sublis alist (car tree)) (cl--sublis alist (cdr tree))))
- (t tree))))
-
;; Compile-time optimizations for some functions defined in this package.
(defun cl--compiler-macro-member (form a list &rest keys)
(declare (debug cl-defmacro) (doc-string 3) (indent 2))
`(cl-eval-when (compile load eval)
(put ',name 'cl-deftype-handler
- (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body)))))
+ (cl-function (lambda (&cl-defs ('*) ,@arglist) ,@body)))))
+
+(cl-deftype extended-char () `(and character (not base-char)))
;;; Additional functions that we can now define because we've defined
;;; `cl-defsubst' and `cl-typep'.
-(cl-defsubst cl-struct-slot-value (struct-type slot-name inst)
- ;; The use of `cl-defsubst' here gives us both a compiler-macro
- ;; and a gv-expander "for free".
+(define-inline cl-struct-slot-value (struct-type slot-name inst)
"Return the value of slot SLOT-NAME in INST of STRUCT-TYPE.
STRUCT and SLOT-NAME are symbols. INST is a structure instance."
(declare (side-effect-free t))
- (unless (cl-typep inst struct-type)
- (signal 'wrong-type-argument (list struct-type inst)))
- ;; We could use `elt', but since the byte compiler will resolve the
- ;; branch below at compile time, it's more efficient to use the
- ;; type-specific accessor.
- (if (eq (cl-struct-sequence-type struct-type) 'vector)
- (aref inst (cl-struct-slot-offset struct-type slot-name))
- (nth (cl-struct-slot-offset struct-type slot-name) inst)))
+ (inline-letevals (struct-type slot-name inst)
+ (inline-quote
+ (progn
+ (unless (cl-typep ,inst ,struct-type)
+ (signal 'wrong-type-argument (list ,struct-type ,inst)))
+ ;; We could use `elt', but since the byte compiler will resolve the
+ ;; branch below at compile time, it's more efficient to use the
+ ;; type-specific accessor.
+ (if (eq (cl-struct-sequence-type ,struct-type) 'list)
+ (nth (cl-struct-slot-offset ,struct-type ,slot-name) ,inst)
+ (aref ,inst (cl-struct-slot-offset ,struct-type ,slot-name)))))))
(run-hooks 'cl-macs-load-hook)
;;; Commentary:
-;; The expectation is that structs defined with cl-defstruct do not
-;; need cl-lib at run-time, but we'd like to hide the details of the
-;; cl-struct metadata behind the cl-struct-define function, so we put
-;; it in this pre-loaded file.
+;; The cl-defstruct macro is full of circularities, since it uses the
+;; cl-structure-class type (and its accessors) which is defined with itself,
+;; and it setups a default parent (cl-structure-object) which is also defined
+;; with cl-defstruct, and to make things more interesting, the class of
+;; cl-structure-object is of course an object of type cl-structure-class while
+;; cl-structure-class's parent is cl-structure-object.
+;; Furthermore, the code generated by cl-defstruct generally assumes that the
+;; parent will be loaded when the child is loaded. But at the same time, the
+;; expectation is that structs defined with cl-defstruct do not need cl-lib at
+;; run-time, which means that the `cl-structure-object' parent can't be in
+;; cl-lib but should be preloaded. So here's this preloaded circular setup.
;;; Code:
+(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'cl-macs)) ;For cl--struct-class.
+
+;; The `assert' macro from the cl package signals
+;; `cl-assertion-failed' at runtime so always define it.
+(define-error 'cl-assertion-failed (purecopy "Assertion failed"))
+
+(defun cl--assertion-failed (form &optional string sargs args)
+ (if debug-on-error
+ (debug `(cl-assertion-failed ,form ,string ,@sargs))
+ (if string
+ (apply #'error string (append sargs args))
+ (signal 'cl-assertion-failed `(,form ,@sargs)))))
+
+;; When we load this (compiled) file during pre-loading, the cl--struct-class
+;; code below will need to access the `cl-struct' info, since it's considered
+;; already as its parent (because `cl-struct' was defined while the file was
+;; compiled). So let's temporarily setup a fake.
+(defvar cl-struct-cl-structure-object-tags nil)
+(unless (cl--find-class 'cl-structure-object)
+ (setf (cl--find-class 'cl-structure-object) 'dummy))
+
+(fset 'cl--make-slot-desc
+ ;; To break circularity, we pre-define the slot constructor by hand.
+ ;; It's redefined a bit further down as part of the cl-defstruct of
+ ;; cl--slot-descriptor.
+ ;; BEWARE: Obviously, it's important to keep the two in sync!
+ (lambda (name &optional initform type props)
+ (vector 'cl-struct-cl-slot-descriptor
+ name initform type props)))
+
+(defun cl--struct-get-class (name)
+ (or (if (not (symbolp name)) name)
+ (cl--find-class name)
+ (if (not (get name 'cl-struct-type))
+ ;; FIXME: Add a conversion for `eieio--class' so we can
+ ;; create a cl-defstruct that inherits from an eieio class?
+ (error "%S is not a struct name" name)
+ ;; Backward compatibility with a defstruct compiled with a version
+ ;; cl-defstruct from Emacs<25. Convert to new format.
+ (let ((tag (intern (format "cl-struct-%s" name)))
+ (type-and-named (get name 'cl-struct-type))
+ (descs (get name 'cl-struct-slots)))
+ (cl-struct-define name nil (get name 'cl-struct-include)
+ (unless (and (eq (car type-and-named) 'vector)
+ (null (cadr type-and-named))
+ (assq 'cl-tag-slot descs))
+ (car type-and-named))
+ (cadr type-and-named)
+ descs
+ (intern (format "cl-struct-%s-tags" name))
+ tag
+ (get name 'cl-struct-print))
+ (cl--find-class name)))))
+
+(defun cl--plist-remove (plist member)
+ (cond
+ ((null plist) nil)
+ ((null member) plist)
+ ((eq plist member) (cddr plist))
+ (t `(,(car plist) ,(cadr plist) ,@(cl--plist-remove (cddr plist) member)))))
+
+(defun cl--struct-register-child (parent tag)
+ ;; Can't use (cl-typep parent 'cl-structure-class) at this stage
+ ;; because `cl-structure-class' is defined later.
+ (while (vectorp parent)
+ (add-to-list (cl--struct-class-children-sym parent) tag)
+ ;; Only register ourselves as a child of the leftmost parent since structs
+ ;; can only only have one parent.
+ (setq parent (car (cl--struct-class-parents parent)))))
+
+;;;###autoload
(defun cl-struct-define (name docstring parent type named slots children-sym
- tag print-auto)
+ tag print)
+ (cl-assert (or type (not named)))
(if (boundp children-sym)
(add-to-list children-sym tag)
(set children-sym (list tag)))
- ;; If the cl-generic support, we need to be able to check
- ;; if a vector is a cl-struct object, without knowing its particular type.
- ;; So we use the (otherwise) unused function slots of the tag symbol
- ;; to put a special witness value, to make the check easy and reliable.
- (unless named (fset tag :quick-object-witness-check))
- (put name 'cl-struct-slots slots)
- (put name 'cl-struct-type (list type named))
- (if parent (put name 'cl-struct-include parent))
- (if print-auto (put name 'cl-struct-print print-auto))
- (if docstring (put name 'structure-documentation docstring)))
+ (and (null type) (eq (caar slots) 'cl-tag-slot)
+ ;; Hide the tag slot from "standard" (i.e. non-`type'd) structs.
+ (setq slots (cdr slots)))
+ (let* ((parent-class (when parent (cl--struct-get-class parent)))
+ (n (length slots))
+ (index-table (make-hash-table :test 'eq :size n))
+ (vslots (let ((v (make-vector n nil))
+ (i 0)
+ (offset (if type 0 1)))
+ (dolist (slot slots)
+ (let* ((props (cddr slot))
+ (typep (plist-member props :type))
+ (type (if typep (cadr typep) t)))
+ (aset v i (cl--make-slot-desc
+ (car slot) (nth 1 slot)
+ type (cl--plist-remove props typep))))
+ (puthash (car slot) (+ i offset) index-table)
+ (cl-incf i))
+ v))
+ (class (cl--struct-new-class
+ name docstring
+ (unless (symbolp parent-class) (list parent-class))
+ type named vslots index-table children-sym tag print)))
+ (unless (symbolp parent-class)
+ (let ((pslots (cl--struct-class-slots parent-class)))
+ (or (>= n (length pslots))
+ (let ((ok t))
+ (dotimes (i (length pslots))
+ (unless (eq (cl--slot-descriptor-name (aref pslots i))
+ (cl--slot-descriptor-name (aref vslots i)))
+ (setq ok nil)))
+ ok)
+ (error "Included struct %S has changed since compilation of %S"
+ parent name))))
+ (cl--struct-register-child parent-class tag)
+ (unless (eq named t)
+ (eval `(defconst ,tag ',class) t)
+ ;; In the cl-generic support, we need to be able to check
+ ;; if a vector is a cl-struct object, without knowing its particular type.
+ ;; So we use the (otherwise) unused function slots of the tag symbol
+ ;; to put a special witness value, to make the check easy and reliable.
+ (fset tag :quick-object-witness-check))
+ (setf (cl--find-class name) class)))
+
+(cl-defstruct (cl-structure-class
+ (:conc-name cl--struct-class-)
+ (:predicate cl--struct-class-p)
+ (:constructor nil)
+ (:constructor cl--struct-new-class
+ (name docstring parents type named slots index-table
+ children-sym tag print))
+ (:copier nil))
+ "The type of CL structs descriptors."
+ ;; The first few fields here are actually inherited from cl--class, but we
+ ;; have to define this one before, to break the circularity, so we manually
+ ;; list the fields here and later "backpatch" cl--class as the parent.
+ ;; BEWARE: Obviously, it's indispensable to keep these two structs in sync!
+ (name nil :type symbol) ;The type name.
+ (docstring nil :type string)
+ (parents nil :type (list-of cl--class)) ;The included struct.
+ (slots nil :type (vector cl--slot-descriptor))
+ (index-table nil :type hash-table)
+ (tag nil :type symbol) ;Placed in cl-tag-slot. Holds the struct-class object.
+ (type nil :type (memq (vector list)))
+ (named nil :type bool)
+ (print nil :type bool)
+ (children-sym nil :type symbol) ;This sym's value holds the tags of children.
+ )
+
+(cl-defstruct (cl-structure-object
+ (:predicate cl-struct-p)
+ (:constructor nil)
+ (:copier nil))
+ "The root parent of all \"normal\" CL structs")
+
+(setq cl--struct-default-parent 'cl-structure-object)
+
+(cl-defstruct (cl-slot-descriptor
+ (:conc-name cl--slot-descriptor-)
+ (:constructor nil)
+ (:constructor cl--make-slot-descriptor
+ (name &optional initform type props))
+ (:copier cl--copy-slot-descriptor))
+ ;; FIXME: This is actually not used yet, for circularity reasons!
+ "Descriptor of structure slot."
+ name ;Attribute name (symbol).
+ initform
+ type
+ ;; Extra properties, kept in an alist, can include:
+ ;; :documentation, :protection, :custom, :label, :group, :printer.
+ (props nil :type alist))
+
+(cl-defstruct (cl--class
+ (:constructor nil)
+ (:copier nil))
+ "Type of descriptors for any kind of structure-like data."
+ ;; Intended to be shared between defstruct and defclass.
+ (name nil :type symbol) ;The type name.
+ (docstring nil :type string)
+ ;; For structs there can only be one parent, but when EIEIO classes inherit
+ ;; from cl--class, we'll need this to hold a list.
+ (parents nil :type (list-of cl--class))
+ (slots nil :type (vector cl-slot-descriptor))
+ (index-table nil :type hash-table))
+
+(cl-assert
+ (let ((sc-slots (cl--struct-class-slots (cl--find-class 'cl-structure-class)))
+ (c-slots (cl--struct-class-slots (cl--find-class 'cl--class)))
+ (eq t))
+ (dotimes (i (length c-slots))
+ (let ((sc-slot (aref sc-slots i))
+ (c-slot (aref c-slots i)))
+ (unless (eq (cl--slot-descriptor-name sc-slot)
+ (cl--slot-descriptor-name c-slot))
+ (setq eq nil))))
+ eq))
+
+;; Close the recursion between cl-structure-object and cl-structure-class.
+(setf (cl--struct-class-parents (cl--find-class 'cl-structure-class))
+ (list (cl--find-class 'cl--class)))
+(cl--struct-register-child
+ (cl--find-class 'cl--class)
+ (cl--struct-class-tag (cl--find-class 'cl-structure-class)))
+
+(cl-assert (cl--find-class 'cl-structure-class))
+(cl-assert (cl--find-class 'cl-structure-object))
+(cl-assert (cl-struct-p (cl--find-class 'cl-structure-class)))
+(cl-assert (cl-struct-p (cl--find-class 'cl-structure-object)))
+(cl-assert (cl--class-p (cl--find-class 'cl-structure-class)))
+(cl-assert (cl--class-p (cl--find-class 'cl-structure-object)))
+
+;; Make sure functions defined with cl-defsubst can be inlined even in
+;; packages which do not require CL. We don't put an autoload cookie
+;; directly on that function, since those cookies only go to cl-loaddefs.
+(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)
(provide 'cl-preloaded)
;;; cl-preloaded.el ends here
"Non-nil if we expect to get back in the debugger soon.")
(defvar inhibit-debug-on-entry nil
- "Non-nil means that debug-on-entry is disabled.")
+ "Non-nil means that `debug-on-entry' is disabled.")
(defvar debugger-jumping-flag nil
- "Non-nil means that debug-on-entry is disabled.
+ "Non-nil means that `debug-on-entry' is disabled.
This variable is used by `debugger-jump', `debugger-step-through',
and `debugger-reenable' to temporarily disable debug-on-entry.")
;; Don't let these magic variables affect the debugger itself.
(let ((last-command nil) this-command track-mouse
(inhibit-trace t)
- (inhibit-debug-on-entry t)
unread-command-events
unread-post-input-method-events
last-input-event last-command-event last-nonmenu-event
debugger-buffer
`((display-buffer-reuse-window
display-buffer-in-previous-window)
- . (,(when debugger-previous-window
- `(previous-window . ,debugger-previous-window)))))
+ . (,(when (and (window-live-p debugger-previous-window)
+ (frame-visible-p
+ (window-frame debugger-previous-window)))
+ `(previous-window . ,debugger-previous-window)))))
(setq debugger-window (selected-window))
(if (eq debugger-previous-window debugger-window)
(when debugger-jumping-flag
(defmacro debugger-env-macro (&rest body)
"Run BODY in original environment."
(declare (indent 0))
- `(save-excursion
- (if (null (buffer-live-p debugger-old-buffer))
- ;; old buffer deleted
- (setq debugger-old-buffer (current-buffer)))
- (set-buffer debugger-old-buffer)
+ `(progn
(set-match-data debugger-outer-match-data)
(prog1
(progn ,@body)
functions to break on entry."
(if (or inhibit-debug-on-entry debugger-jumping-flag)
nil
- (funcall debugger 'debug)))
+ (let ((inhibit-debug-on-entry t))
+ (funcall debugger 'debug))))
;;;###autoload
(defun debug-on-entry (function)
BODY contains code to execute each time the mode is enabled or disabled.
It is executed after toggling the mode, and before running MODE-hook.
Before the actual body code, you can write keyword arguments, i.e.
- alternating keywords and values. These following special keywords
- are supported (other keywords are passed to `defcustom' if the minor
- mode is global):
+ alternating keywords and values. If you provide BODY, then you must
+ provide (even if just nil) INIT-VALUE, LIGHTER, and KEYMAP, or provide
+ at least one keyword argument, or both; otherwise, BODY would be
+ misinterpreted as the first omitted argument. The following special
+ keywords are supported (other keywords are passed to `defcustom' if
+ the minor mode is global):
:group GROUP Custom group name to use in all generated `defcustom' forms.
Defaults to MODE without the possible trailing \"-mode\".
;; Allow skipping the first three args.
(cond
((keywordp init-value)
- (setq body `(,init-value ,lighter ,keymap ,@body)
+ (setq body (if keymap `(,init-value ,lighter ,keymap ,@body)
+ `(,init-value ,lighter))
init-value nil lighter nil keymap nil))
((keywordp lighter)
(setq body `(,lighter ,keymap ,@body) lighter nil keymap nil))
(if (called-interactively-p 'any)
(progn
,(if (and globalp (symbolp mode))
+ ;; Unnecessary but harmless if mode set buffer-locally
`(customize-mark-as-set ',mode))
;; Avoid overwriting a message shown by the body,
;; but do overwrite previous messages.
(unless (and (current-message)
(not (equal ,last-message
(current-message))))
- (message ,(format "%s %%sabled" pretty-name)
- (if ,mode "en" "dis")))))
+ (let ((local
+ ,(if globalp
+ (if (symbolp mode)
+ `(if (local-variable-p ',mode)
+ " in current buffer"
+ "")
+ "")
+ " in current buffer")))
+ (message ,(format "%s %%sabled%%s" pretty-name)
+ (if ,mode "en" "dis") local)))))
,@(when after-hook `(,after-hook)))
(force-mode-line-update)
;; Return the new setting.
(defalias 'edebug-mark-marker 'mark-marker)
(defun edebug--display (value offset-index arg-mode)
+ ;; edebug--display-1 is too big, we should split it. This function
+ ;; here was just introduced to avoid making edebug--display-1
+ ;; yet a bit deeper.
+ (save-excursion (edebug--display-1 value offset-index arg-mode)))
+
+(defun edebug--display-1 (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
edebug-function)
))
- (setcdr edebug-window-data
- (edebug-adjust-window (cdr edebug-window-data)))
-
- ;; Test if there is input, not including keyboard macros.
- (if (input-pending-p)
- (progn
- (setq edebug-execution-mode 'step
- edebug-stop t)
- (edebug-stop)
- ;; (discard-input) ; is this unfriendly??
- ))
-
;; Make sure we bind those in the right buffer (bug#16410).
(let ((overlay-arrow-position overlay-arrow-position)
(overlay-arrow-string overlay-arrow-string))
((eq edebug-execution-mode 'Trace-fast)
(sit-for 0))) ; Force update and continue.
+ (when (input-pending-p)
+ (setq edebug-stop t)
+ (setq edebug-execution-mode 'step) ; for `edebug-overlay-arrow'
+ (edebug-stop))
+
+ (edebug-overlay-arrow)
+
(unwind-protect
(if (or edebug-stop
(memq edebug-execution-mode '(step next))
(eq arg-mode 'error))
- (progn
- ;; (setq edebug-execution-mode 'step)
- ;; (edebug-overlay-arrow) ; This doesn't always show up.
- (edebug--recursive-edit arg-mode))) ; <--- 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)
(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 (buffer-name edebug-buffer) ; if it still exists
(progn
(set-buffer edebug-buffer)
- (if (memq edebug-execution-mode '(go Go-nonstop))
- (edebug-overlay-arrow))
+ (when (memq edebug-execution-mode '(go Go-nonstop))
+ (edebug-overlay-arrow)
+ (sit-for 0))
(edebug-mode -1))
;; gotta have a buffer to let its buffer local variables be set
(get-buffer-create " bogus edebug buffer"))
;;; 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)
- (if (not (pos-visible-in-window-p))
- (progn
- ;; First try old-start
- (if old-start
- (set-window-start (selected-window) old-start))
- (if (not (pos-visible-in-window-p))
- (progn
- ;; (message "resetting window start") (sit-for 2)
- (set-window-start
- (selected-window)
- (save-excursion
- (forward-line
- (if (< (point) (window-start)) -1 ; one line before if in back
- (- (/ (window-height) 2)) ; center the line moving forward
- ))
- (beginning-of-line)
- (point)))))))
- (window-start))
-
-
-
(defconst edebug-arrow-alist
'((Continue-fast . "=")
(Trace-fast . "-")
(step . "=>")
(next . "=>")
(go . "<>")
- (Go-nonstop . "..") ; not used
+ (Go-nonstop . "..")
)
"Association list of arrows for each edebug mode.")
;; Restore outside context.
(setq-default cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w)
(unwind-protect
+ ;; FIXME: This restoring of edebug-outside-buffer and
+ ;; edebug-outside-point is redundant now that backtrace-eval does it
+ ;; for us.
(with-current-buffer edebug-outside-buffer ; of edebug-buffer
(goto-char edebug-outside-point)
(if (marker-buffer (edebug-mark-marker))
A singleton is a class which will only ever have one instance."
:abstract t)
-(cl-defmethod eieio-constructor ((class (subclass eieio-singleton)) &rest _slots)
+(cl-defmethod make-instance ((class (subclass eieio-singleton)) &rest _slots)
"Constructor for singleton CLASS.
NAME and SLOTS initialize the new object.
This constructor guarantees that no matter how many you request,
Note: This function recurses when a slot of :type of some object is
identified, and needing more object creation."
- (let ((objclass (nth 0 inputlist))
- ;; (objname (nth 1 inputlist))
- (slots (nthcdr 2 inputlist))
- (createslots nil))
-
- ;; If OBJCLASS is an eieio autoload object, then we need to load it.
- (eieio-class-un-autoload objclass)
+ (let* ((objclass (nth 0 inputlist))
+ ;; (objname (nth 1 inputlist))
+ (slots (nthcdr 2 inputlist))
+ (createslots nil)
+ (class
+ (progn
+ ;; If OBJCLASS is an eieio autoload object, then we need to
+ ;; load it.
+ (eieio-class-un-autoload objclass)
+ (eieio--class-object objclass))))
(while slots
- (let ((name (car slots))
+ (let ((initarg (car slots))
(value (car (cdr slots))))
;; Make sure that the value proposed for SLOT is valid.
;; In addition, strip out quotes, list functions, and update
;; object constructors as needed.
(setq value (eieio-persistent-validate/fix-slot-value
- (eieio--class-v objclass) name value))
+ class (eieio--initarg-to-attribute class initarg) value))
- (push name createslots)
+ (push initarg createslots)
(push value createslots)
)
Second, any text properties will be stripped from strings."
(cond ((consp proposed-value)
;; Lists with something in them need special treatment.
- (let ((slot-idx (eieio--slot-name-index class
- nil slot))
- (type nil)
- (classtype nil))
- (setq slot-idx (- slot-idx
- (eval-when-compile eieio--object-num-slots)))
- (setq type (aref (eieio--class-public-type class)
- slot-idx))
-
- (setq classtype (eieio-persistent-slot-type-is-class-p
- type))
+ (let* ((slot-idx (- (eieio--slot-name-index class slot)
+ (eval-when-compile
+ (length (cl-struct-slot-info 'eieio--object)))))
+ (type (cl--slot-descriptor-type (aref (eieio--class-slots class)
+ slot-idx)))
+ (classtype (eieio-persistent-slot-type-is-class-p type)))
(cond ((eq (car proposed-value) 'quote)
(car (cdr proposed-value)))
(concat nm "-1")))))
nobj))
+(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)
+ (if (not (stringp (car args)))
+ (cl-call-next-method)
+ (funcall (if eieio-backward-compatibility #'ignore #'message)
+ "Obsolete: name passed without :object-name to %S constructor"
+ class)
+ (apply #'cl-call-next-method class :object-name args)))
+
+
(provide 'eieio-base)
;;; eieio-base.el ends here
(defgeneric ,method ,args)
(eieio--defmethod ',method ',key ',class #',code))))
-(add-function :before-until cl-generic-tagcode-function
- #'eieio--generic-static-tagcode)
-(defun eieio--generic-static-tagcode (type name)
- (and (eq 'eieio--static (car-safe type))
- `(40 . (cond
- ((symbolp ,name) (eieio--class-v ,name))
- ((vectorp ,name) (aref ,name 0))))))
-
-(add-function :around cl-generic-tag-types-function
- #'eieio--generic-static-tag-types)
-(defun eieio--generic-static-tag-types (orig-fun tag)
- (cond
- ((or (eieio--class-p tag)
- (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag))))
- (let ((superclasses (funcall orig-fun tag))
- (types ()))
- ;; Interleave: (subclass <foo>) (eieio--static <foo>) <subclass <bar>) ..
+(defun eieio--generic-static-symbol-specializers (tag)
+ (cl-assert (or (null tag) (eieio--class-p tag)))
+ (when (eieio--class-p tag)
+ (let ((superclasses (eieio--generic-subclass-specializers tag))
+ (specializers ()))
(dolist (superclass superclasses)
- (push superclass types)
- (push `(eieio--static
- ,(if (consp superclass) (cadr superclass) superclass))
- types))
- (nreverse types)))
- (t (funcall orig-fun tag))))
+ (push superclass specializers)
+ (push `(eieio--static ,(cadr superclass)) specializers))
+ (nreverse specializers))))
+
+(defconst eieio--generic-static-symbol-generalizer
+ (cl-generic-make-generalizer
+ ;; Give it a slightly higher priority than `subclass' so that the
+ ;; interleaved list comes before subclass's non-interleaved list.
+ 61 (lambda (name) `(and (symbolp ,name) (eieio--class-v ,name)))
+ #'eieio--generic-static-symbol-specializers))
+(defconst eieio--generic-static-object-generalizer
+ (cl-generic-make-generalizer
+ ;; Give it a slightly higher priority than `class' so that the
+ ;; interleaved list comes before the class's non-interleaved list.
+ 51 #'cl--generic-struct-tag
+ (lambda (tag)
+ (and (symbolp tag) (boundp tag) (setq tag (symbol-value tag))
+ (eieio--class-p tag)
+ (let ((superclasses (eieio--class-precedence-list tag))
+ (specializers ()))
+ (dolist (superclass superclasses)
+ (setq superclass (eieio--class-name superclass))
+ (push superclass specializers)
+ (push `(eieio--static ,superclass) specializers))
+ (nreverse specializers))))))
+
+(cl-defmethod cl-generic-generalizers ((_specializer (head eieio--static)))
+ (list eieio--generic-static-symbol-generalizer
+ eieio--generic-static-object-generalizer))
;;;###autoload
(defun eieio--defgeneric-init-form (method doc-string)
(args (help-function-arglist code 'preserve-names))
(doc-only (if docstring
(let ((split (help-split-fundoc docstring nil)))
- (if split (cdr split) docstring))))
- (new-docstring (help-add-fundoc-usage doc-only
- (cons 'cl-cnm args))))
- ;; FIXME: ¡Add new-docstring to those closures!
+ (if split (cdr split) docstring)))))
(lambda (cnm &rest args)
+ (:documentation
+ (help-add-fundoc-usage doc-only (cons 'cl-cnm args)))
(cl-letf (((symbol-function 'call-next-method) cnm)
((symbol-function 'next-method-p)
(lambda () (cl--generic-isnot-nnm-p cnm))))
;; Arrange for field access not to bother checking if the access is indeed
;; made to an eieio--class object.
(cl-declaim (optimize (safety 0)))
+
(cl-defstruct (eieio--class
(:constructor nil)
- (:constructor eieio--class-make (symbol &aux (tag 'defclass)))
+ (:constructor eieio--class-make (name &aux (tag 'defclass)))
(:type vector)
(:copier nil))
;; We use an untagged cl-struct, with our own hand-made tag as first field
;; predicate for us), but that breaks compatibility with .elc files compiled
;; against older versions of EIEIO.
tag
- symbol ;; symbol (self-referencing)
- parent children
- symbol-hashtable ;; hashtable permitting fast access to variable position indexes
- ;; @todo
- ;; the word "public" here is leftovers from the very first version.
- ;; Get rid of it!
- public-a ;; class attribute index
- public-d ;; class attribute defaults index
- public-doc ;; class documentation strings for attributes
- public-type ;; class type for a slot
- public-custom ;; class custom type for a slot
- public-custom-label ;; class custom group for a slot
- public-custom-group ;; class custom group for a slot
- public-printer ;; printer for a slot
- protection ;; protection for a slot
+ ;; Fields we could inherit from cl--class (if we used a tagged cl-struct):
+ (name nil :type symbol) ;The type name.
+ (docstring nil :type string)
+ (parents nil :type (or eieio--class (list-of eieio--class)))
+ (slots nil :type (vector cl-slot-descriptor))
+ (index-table nil :type hash-table)
+ ;; Fields specific to EIEIO classes:
+ children
initarg-tuples ;; initarg tuples list
- class-allocation-a ;; class allocated attributes
- class-allocation-doc ;; class allocated documentation
- class-allocation-type ;; class allocated value type
- class-allocation-custom ;; class allocated custom descriptor
- class-allocation-custom-label ;; class allocated custom descriptor
- class-allocation-custom-group ;; class allocated custom group
- class-allocation-printer ;; class allocated printer for a slot
- class-allocation-protection ;; class allocated protection list
+ (class-slots nil :type eieio--slot)
class-allocation-values ;; class allocated value vector
default-object-cache ;; what a newly created object would look like.
; This will speed up instantiation time as
;; object/struct in its `symbol-value' slot.
class-tag)
-(eval-and-compile
+(eval-when-compile
(defconst eieio--object-num-slots
- (length (get 'eieio--object 'cl-struct-slots))))
+ (length (cl-struct-slot-info 'eieio--object))))
-(defsubst eieio--object-class-object (obj)
+(defsubst eieio--object-class (obj)
(symbol-value (eieio--object-class-tag obj)))
-(defsubst eieio--object-class-name (obj)
- ;; FIXME: Most uses of this function should be changed to use
- ;; eieio--object-class-object instead!
- (eieio--class-symbol (eieio--object-class-object obj)))
-
\f
;;; Important macros used internally in eieio.
CLASS is a symbol." ;FIXME: Is it a vector or a symbol?
(and (symbolp class) (eieio--class-p (eieio--class-v class))))
+(defun eieio--class-print-name (class)
+ "Return a printed representation of CLASS."
+ (format "#<class %s>" (eieio-class-name class)))
+
(defun eieio-class-name (class)
"Return a Lisp like symbol name for CLASS."
- ;; FIXME: What's a "Lisp like symbol name"?
- ;; FIXME: CLOS returns a symbol, but the code returns a string.
- (if (eieio--class-p class) (setq class (eieio--class-symbol class)))
- (cl-check-type class class)
- ;; I think this is supposed to return a symbol, but to me CLASS is a symbol,
- ;; and I wanted a string. Arg!
- (format "#<class %s>" (symbol-name class)))
+ (setq class (eieio--class-object class))
+ (cl-check-type class eieio--class)
+ (eieio--class-name class))
(define-obsolete-function-alias 'class-name #'eieio-class-name "24.4")
(defalias 'eieio--class-constructor #'identity
(defun eieio-make-class-predicate (class)
(lambda (obj)
- ;; (:docstring (format "Test OBJ to see if it's an object of type %S."
- ;; class))
+ (:documentation
+ (format "Return non-nil if OBJ is an object of type `%S'.\n\n(fn OBJ)"
+ class))
(and (eieio-object-p obj)
(same-class-p obj class))))
(defun eieio-make-child-predicate (class)
(lambda (obj)
- ;; (:docstring (format
- ;; "Test OBJ to see if it's an object is a child of type %S."
- ;; class))
+ (:documentation
+ (format "Return non-nil if OBJ is an object of type `%S' or a subclass.
+\n(fn OBJ)" class))
(and (eieio-object-p obj)
(object-of-class-p obj class))))
(run-hooks 'eieio-hook)
(setq eieio-hook nil)
- (let* ((pname superclasses)
- (oldc (let ((c (eieio--class-v cname))) (if (eieio--class-p c) c)))
+ (let* ((oldc (let ((c (eieio--class-v cname))) (if (eieio--class-p c) c)))
(newc (if (and oldc (not (eieio--class-default-object-cache oldc)))
;; The oldc class is a stub setup by eieio-defclass-autoload.
;; Reuse it instead of creating a new one, so that existing
- ;; references are still valid.
+ ;; references stay valid.
oldc
(eieio--class-make cname)))
(groups nil) ;; list of groups id'd from slots
(setf (eieio--class-children newc) children)
(remhash cname eieio-defclass-autoload-map))))
- (if pname
+ (if superclasses
(progn
- (dolist (p pname)
+ (dolist (p superclasses)
(if (not (and p (symbolp p)))
(error "Invalid parent class %S" p)
(let ((c (eieio--class-v p)))
(mapc (lambda (g) (cl-pushnew g groups :test #'equal))
(eieio--class-option c :custom-groups))
;; Save parent in child.
- (push c (eieio--class-parent newc))))))
+ (push c (eieio--class-parents newc))))))
;; Reverse the list of our parents so that they are prioritized in
;; the same order as specified in the code.
- (cl-callf nreverse (eieio--class-parent newc)))
+ (cl-callf nreverse (eieio--class-parents newc)))
;; If there is nothing to loop over, then inherit from the
;; default superclass.
(unless (eq cname 'eieio-default-superclass)
;; save new child in parent
(cl-pushnew cname (eieio--class-children eieio-default-superclass))
;; save parent in child
- (setf (eieio--class-parent newc) (list eieio-default-superclass))))
+ (setf (eieio--class-parents newc) (list eieio-default-superclass))))
;; turn this into a usable self-pointing symbol; FIXME: Why?
(when eieio-backward-compatibility
;; Before adding new slots, let's add all the methods and classes
;; in from the parent class.
- (eieio-copy-parents-into-subclass newc superclasses)
+ (eieio-copy-parents-into-subclass newc)
;; Store the new class vector definition into the symbol. We need to
;; do this first so that we can call defmethod for the accessor.
(make-obsolete-variable
initarg (format "use '%s instead" initarg) "25.1"))))
- ;; The customgroup should be a list of symbols
- (cond ((null customg)
+ ;; The customgroup should be a list of symbols.
+ (cond ((and (null customg) custom)
(setq customg '(default)))
((not (listp customg))
(setq customg (list customg))))
- ;; The customgroup better be a symbol, or list of symbols.
- (mapc (lambda (cg)
- (if (not (symbolp cg))
- (signal 'invalid-slot-type (list :group cg))))
- customg)
+ ;; The customgroup better be a list of symbols.
+ (dolist (cg customg)
+ (unless (symbolp cg)
+ (signal 'invalid-slot-type (list :group cg))))
;; First up, add this slot into our new class.
- (eieio--add-new-slot newc name init docstr type custom label customg printer
- prot initarg alloc 'defaultoverride skip-nil)
+ (eieio--add-new-slot
+ newc (cl--make-slot-descriptor
+ name init type
+ `(,@(if docstr `((:documentation . ,docstr)))
+ ,@(if custom `((:custom . ,custom)))
+ ,@(if label `((:label . ,label)))
+ ,@(if customg `((:group . ,customg)))
+ ,@(if printer `((:printer . ,printer)))
+ ,@(if prot `((:protection . ,prot)))))
+ initarg alloc 'defaultoverride skip-nil)
;; We need to id the group, and store them in a group list attribute.
(dolist (cg customg)
- (cl-pushnew cg groups :test 'equal))
+ (cl-pushnew cg groups :test #'equal))
))
;; Now that everything has been loaded up, all our lists are backwards!
- ;; Fix that up now.
- (cl-callf nreverse (eieio--class-public-a newc))
- (cl-callf nreverse (eieio--class-public-d newc))
- (cl-callf nreverse (eieio--class-public-doc newc))
- (cl-callf (lambda (types) (apply #'vector (nreverse types)))
- (eieio--class-public-type newc))
- (cl-callf nreverse (eieio--class-public-custom newc))
- (cl-callf nreverse (eieio--class-public-custom-label newc))
- (cl-callf nreverse (eieio--class-public-custom-group newc))
- (cl-callf nreverse (eieio--class-public-printer newc))
- (cl-callf nreverse (eieio--class-protection newc))
+ ;; Fix that up now and then them into vectors.
+ (cl-callf (lambda (slots) (apply #'vector (nreverse slots)))
+ (eieio--class-slots newc))
(cl-callf nreverse (eieio--class-initarg-tuples newc))
;; The storage for class-class-allocation-type needs to be turned into
;; a vector now.
- (cl-callf (lambda (cat) (apply #'vector cat))
- (eieio--class-class-allocation-type newc))
-
- ;; Also, take class allocated values, and vectorize them for speed.
- (cl-callf (lambda (cavs) (apply #'vector cavs))
- (eieio--class-class-allocation-values newc))
+ (cl-callf (lambda (slots) (apply #'vector slots))
+ (eieio--class-class-slots newc))
+
+ ;; Also, setup the class allocated values.
+ (let* ((slots (eieio--class-class-slots newc))
+ (n (length slots))
+ (v (make-vector n nil)))
+ (dotimes (i n)
+ (setf (aref v i) (eieio-default-eval-maybe
+ (cl--slot-descriptor-initform (aref slots i)))))
+ (setf (eieio--class-class-allocation-values newc) v))
;; Attach slot symbols into a hashtable, and store the index of
;; this slot as the value this table.
- (let* ((cnt 0)
- (pubsyms (eieio--class-public-a newc))
- (prots (eieio--class-protection newc))
+ (let* ((slots (eieio--class-slots newc))
+ ;; (cslots (eieio--class-class-slots newc))
(oa (make-hash-table :test #'eq)))
- (while pubsyms
- (let ((newsym (list cnt)))
- (setf (gethash (car pubsyms) oa) newsym)
- (setq cnt (1+ cnt))
- (if (car prots) (setcdr newsym (car prots))))
- (setq pubsyms (cdr pubsyms)
- prots (cdr prots)))
- (setf (eieio--class-symbol-hashtable newc) oa))
+ ;; (dotimes (cnt (length cslots))
+ ;; (setf (gethash (cl--slot-descriptor-name (aref cslots cnt)) oa) (- -1 cnt)))
+ (dotimes (cnt (length slots))
+ (setf (gethash (cl--slot-descriptor-name (aref slots cnt)) oa) cnt))
+ (setf (eieio--class-index-table newc) oa))
;; Set up a specialized doc string.
;; Use stored value since it is calculated in a non-trivial way
- (put cname 'variable-documentation
- (eieio--class-option-assoc options :documentation))
+ (let ((docstring (eieio--class-option-assoc options :documentation)))
+ (setf (eieio--class-docstring newc) docstring)
+ (when eieio-backward-compatibility
+ (put cname 'variable-documentation docstring)))
;; Save the file location where this class is defined.
(add-to-list 'current-load-list `(eieio-defclass . ,cname))
;; if this is a superclass, clear out parent (which was set to the
;; default superclass eieio-default-superclass)
- (if clearparent (setf (eieio--class-parent newc) nil))
+ (if clearparent (setf (eieio--class-parents newc) nil))
;; Create the cached default object.
- (let ((cache (make-vector (+ (length (eieio--class-public-a newc))
+ (let ((cache (make-vector (+ (length (eieio--class-slots newc))
(eval-when-compile eieio--object-num-slots))
nil))
;; We don't strictly speaking need to use a symbol, but the old
"Whether the default value VAL should be evaluated for use."
(and (consp val) (symbolp (car val)) (fboundp (car val))))
-(defun eieio--perform-slot-validation-for-default (slot spec value skipnil)
- "For SLOT, signal if SPEC does not match VALUE.
-If SKIPNIL is non-nil, then if VALUE is nil return t instead."
- (if (not (or (eieio-eval-default-p value) ;FIXME: Why?
- eieio-skip-typecheck
- (and skipnil (null value))
- (eieio--perform-slot-validation spec value)))
- (signal 'invalid-slot-type (list slot spec value))))
-
-(defun eieio--add-new-slot (newc a d doc type cust label custg print prot init alloc
+(defun eieio--perform-slot-validation-for-default (slot skipnil)
+ "For SLOT, signal if its type does not match its default value.
+If SKIPNIL is non-nil, then if default value is nil return t instead."
+ (let ((value (cl--slot-descriptor-initform slot))
+ (spec (cl--slot-descriptor-type slot)))
+ (if (not (or (eieio-eval-default-p value) ;FIXME: Why?
+ eieio-skip-typecheck
+ (and skipnil (null value))
+ (eieio--perform-slot-validation spec value)))
+ (signal 'invalid-slot-type (list (cl--slot-descriptor-name slot) spec value)))))
+
+(defun eieio--slot-override (old new skipnil)
+ (cl-assert (eq (cl--slot-descriptor-name old) (cl--slot-descriptor-name new)))
+ ;; There is a match, and we must override the old value.
+ (let* ((a (cl--slot-descriptor-name old))
+ (tp (cl--slot-descriptor-type old))
+ (d (cl--slot-descriptor-initform new))
+ (type (cl--slot-descriptor-type new))
+ (oprops (cl--slot-descriptor-props old))
+ (nprops (cl--slot-descriptor-props new))
+ (custg (alist-get :group nprops)))
+ ;; If type is passed in, is it the same?
+ (if (not (eq type t))
+ (if (not (equal type tp))
+ (error
+ "Child slot type `%s' does not match inherited type `%s' for `%s'"
+ type tp a))
+ (setf (cl--slot-descriptor-type new) tp))
+ ;; If we have a repeat, only update the initarg...
+ (unless (eq d eieio-unbound)
+ (eieio--perform-slot-validation-for-default new skipnil)
+ (setf (cl--slot-descriptor-initform old) d))
+
+ ;; PLN Tue Jun 26 11:57:06 2007 : The protection is
+ ;; checked and SHOULD match the superclass
+ ;; protection. Otherwise an error is thrown. However
+ ;; I wonder if a more flexible schedule might be
+ ;; implemented.
+ ;;
+ ;; EML - We used to have (if prot... here,
+ ;; but a prot of 'nil means public.
+ ;;
+ (let ((super-prot (alist-get :protection oprops))
+ (prot (alist-get :protection nprops)))
+ (if (not (eq prot super-prot))
+ (error "Child slot protection `%s' does not match inherited protection `%s' for `%s'"
+ prot super-prot a)))
+ ;; End original PLN
+
+ ;; PLN Tue Jun 26 11:57:06 2007 :
+ ;; Do a non redundant combination of ancient custom
+ ;; groups and new ones.
+ (when custg
+ (let* ((list1 (alist-get :group oprops)))
+ (dolist (elt custg)
+ (unless (memq elt list1)
+ (push elt list1)))
+ (setf (alist-get :group (cl--slot-descriptor-props old)) list1)))
+ ;; End PLN
+
+ ;; PLN Mon Jun 25 22:44:34 2007 : If a new cust is
+ ;; set, simply replaces the old one.
+ (dolist (prop '(:custom :label :documentation :printer))
+ (when (alist-get prop (cl--slot-descriptor-props new))
+ (setf (alist-get prop (cl--slot-descriptor-props old))
+ (alist-get prop (cl--slot-descriptor-props new))))
+
+ ) ))
+
+(defun eieio--add-new-slot (newc slot init alloc
&optional defaultoverride skipnil)
- "Add into NEWC attribute A.
-If A already exists in NEWC, then do nothing. If it doesn't exist,
-then also add in D (default), DOC, TYPE, CUST, LABEL, CUSTG, PRINT, PROT, and INIT arg.
+ "Add into NEWC attribute SLOT.
+If a slot of that name already exists in NEWC, then do nothing. If it doesn't exist,
+INIT is the initarg, if any.
Argument ALLOC specifies if the slot is allocated per instance, or per class.
If optional DEFAULTOVERRIDE is non-nil, then if A exists in NEWC,
we must override its value for a default.
Optional argument SKIPNIL indicates if type checking should be skipped
if default value is nil."
;; Make sure we duplicate those items that are sequences.
+ (let* ((a (cl--slot-descriptor-name slot))
+ (d (cl--slot-descriptor-initform slot))
+ (old (car (cl-member a (eieio--class-slots newc)
+ :key #'cl--slot-descriptor-name)))
+ (cold (car (cl-member a (eieio--class-class-slots newc)
+ :key #'cl--slot-descriptor-name))))
(condition-case nil
(if (sequencep d) (setq d (copy-sequence d)))
- ;; This copy can fail on a cons cell with a non-cons in the cdr. Let's skip it if it doesn't work.
+ ;; This copy can fail on a cons cell with a non-cons in the cdr. Let's
+ ;; skip it if it doesn't work.
(error nil))
- (if (sequencep type) (setq type (copy-sequence type)))
- (if (sequencep cust) (setq cust (copy-sequence cust)))
- (if (sequencep custg) (setq custg (copy-sequence custg)))
+ ;; (if (sequencep type) (setq type (copy-sequence type)))
+ ;; (if (sequencep cust) (setq cust (copy-sequence cust)))
+ ;; (if (sequencep custg) (setq custg (copy-sequence custg)))
;; To prevent override information w/out specification of storage,
;; we need to do this little hack.
- (if (member a (eieio--class-class-allocation-a newc)) (setq alloc :class))
+ (if cold (setq alloc :class))
- (if (or (not alloc) (and (symbolp alloc) (eq alloc :instance)))
+ (if (memq alloc '(nil :instance))
;; In this case, we modify the INSTANCE version of a given slot.
-
(progn
-
- ;; Only add this element if it is so-far unique
- (if (not (member a (eieio--class-public-a newc)))
- (progn
- (eieio--perform-slot-validation-for-default a type d skipnil)
- (push a (eieio--class-public-a newc))
- (push d (eieio--class-public-d newc))
- (push doc (eieio--class-public-doc newc))
- (push type (eieio--class-public-type newc))
- (push cust (eieio--class-public-custom newc))
- (push label (eieio--class-public-custom-label newc))
- (push custg (eieio--class-public-custom-group newc))
- (push print (eieio--class-public-printer newc))
- (push prot (eieio--class-protection newc))
- (setf (eieio--class-initarg-tuples newc) (cons (cons init a) (eieio--class-initarg-tuples newc)))
- )
- ;; When defaultoverride is true, we are usually adding new local
- ;; attributes which must override the default value of any slot
- ;; passed in by one of the parent classes.
- (when defaultoverride
- ;; There is a match, and we must override the old value.
- (let* ((ca (eieio--class-public-a newc))
- (np (member a ca))
- (num (- (length ca) (length np)))
- (dp (if np (nthcdr num (eieio--class-public-d newc))
- nil))
- (tp (if np (nth num (eieio--class-public-type newc))))
- )
- (if (not np)
- (error "EIEIO internal error overriding default value for %s"
- a)
- ;; If type is passed in, is it the same?
- (if (not (eq type t))
- (if (not (equal type tp))
- (error
- "Child slot type `%s' does not match inherited type `%s' for `%s'"
- type tp a)))
- ;; If we have a repeat, only update the initarg...
- (unless (eq d eieio-unbound)
- (eieio--perform-slot-validation-for-default a tp d skipnil)
- (setcar dp d))
- ;; If we have a new initarg, check for it.
- (when init
- (let* ((inits (eieio--class-initarg-tuples newc))
- (inita (rassq a inits)))
- ;; Replace the CAR of the associate INITA.
- ;;(message "Initarg: %S replace %s" inita init)
- (setcar inita init)
- ))
-
- ;; PLN Tue Jun 26 11:57:06 2007 : The protection is
- ;; checked and SHOULD match the superclass
- ;; protection. Otherwise an error is thrown. However
- ;; I wonder if a more flexible schedule might be
- ;; implemented.
- ;;
- ;; EML - We used to have (if prot... here,
- ;; but a prot of 'nil means public.
- ;;
- (let ((super-prot (nth num (eieio--class-protection newc)))
- )
- (if (not (eq prot super-prot))
- (error "Child slot protection `%s' does not match inherited protection `%s' for `%s'"
- prot super-prot a)))
- ;; End original PLN
-
- ;; PLN Tue Jun 26 11:57:06 2007 :
- ;; Do a non redundant combination of ancient custom
- ;; groups and new ones.
- (when custg
- (let* ((groups
- (nthcdr num (eieio--class-public-custom-group newc)))
- (list1 (car groups))
- (list2 (if (listp custg) custg (list custg))))
- (if (< (length list1) (length list2))
- (setq list1 (prog1 list2 (setq list2 list1))))
- (dolist (elt list2)
- (unless (memq elt list1)
- (push elt list1)))
- (setcar groups list1)))
- ;; End PLN
-
- ;; PLN Mon Jun 25 22:44:34 2007 : If a new cust is
- ;; set, simply replaces the old one.
- (when cust
- ;; (message "Custom type redefined to %s" cust)
- (setcar (nthcdr num (eieio--class-public-custom newc)) cust))
-
- ;; If a new label is specified, it simply replaces
- ;; the old one.
- (when label
- ;; (message "Custom label redefined to %s" label)
- (setcar (nthcdr num (eieio--class-public-custom-label newc)) label))
- ;; End PLN
-
- ;; PLN Sat Jun 30 17:24:42 2007 : when a new
- ;; doc is specified, simply replaces the old one.
- (when doc
- ;;(message "Documentation redefined to %s" doc)
- (setcar (nthcdr num (eieio--class-public-doc newc))
- doc))
- ;; End PLN
-
- ;; If a new printer is specified, it simply replaces
- ;; the old one.
- (when print
- ;; (message "printer redefined to %s" print)
- (setcar (nthcdr num (eieio--class-public-printer newc)) print))
-
- )))
- ))
+ ;; Only add this element if it is so-far unique
+ (if (not old)
+ (progn
+ (eieio--perform-slot-validation-for-default slot skipnil)
+ (push slot (eieio--class-slots newc))
+ )
+ ;; When defaultoverride is true, we are usually adding new local
+ ;; attributes which must override the default value of any slot
+ ;; passed in by one of the parent classes.
+ (when defaultoverride
+ (eieio--slot-override old slot skipnil)))
+ (when init
+ (cl-pushnew (cons init a) (eieio--class-initarg-tuples newc)
+ :test #'equal)))
;; CLASS ALLOCATED SLOTS
- (let ((value (eieio-default-eval-maybe d)))
- (if (not (member a (eieio--class-class-allocation-a newc)))
- (progn
- (eieio--perform-slot-validation-for-default a type value skipnil)
- ;; Here we have found a :class version of a slot. This
- ;; requires a very different approach.
- (push a (eieio--class-class-allocation-a newc))
- (push doc (eieio--class-class-allocation-doc newc))
- (push type (eieio--class-class-allocation-type newc))
- (push cust (eieio--class-class-allocation-custom newc))
- (push label (eieio--class-class-allocation-custom-label newc))
- (push custg (eieio--class-class-allocation-custom-group newc))
- (push prot (eieio--class-class-allocation-protection newc))
- ;; Default value is stored in the 'values section, since new objects
- ;; can't initialize from this element.
- (push value (eieio--class-class-allocation-values newc)))
- (when defaultoverride
- ;; There is a match, and we must override the old value.
- (let* ((ca (eieio--class-class-allocation-a newc))
- (np (member a ca))
- (num (- (length ca) (length np)))
- (dp (if np
- (nthcdr num
- (eieio--class-class-allocation-values newc))
- nil))
- (tp (if np (nth num (eieio--class-class-allocation-type newc))
- nil)))
- (if (not np)
- (error "EIEIO internal error overriding default value for %s"
- a)
- ;; If type is passed in, is it the same?
- (if (not (eq type t))
- (if (not (equal type tp))
- (error
- "Child slot type `%s' does not match inherited type `%s' for `%s'"
- type tp a)))
- ;; EML - Note: the only reason to override a class bound slot
- ;; is to change the default, so allow unbound in.
-
- ;; If we have a repeat, only update the value...
- (eieio--perform-slot-validation-for-default a tp value skipnil)
- (setcar dp value))
-
- ;; PLN Tue Jun 26 11:57:06 2007 : The protection is
- ;; checked and SHOULD match the superclass
- ;; protection. Otherwise an error is thrown. However
- ;; I wonder if a more flexible schedule might be
- ;; implemented.
- (let ((super-prot
- (car (nthcdr num (eieio--class-class-allocation-protection newc)))))
- (if (not (eq prot super-prot))
- (error "Child slot protection `%s' does not match inherited protection `%s' for `%s'"
- prot super-prot a)))
- ;; Do a non redundant combination of ancient custom groups
- ;; and new ones.
- (when custg
- (let* ((groups
- (nthcdr num (eieio--class-class-allocation-custom-group newc)))
- (list1 (car groups))
- (list2 (if (listp custg) custg (list custg))))
- (if (< (length list1) (length list2))
- (setq list1 (prog1 list2 (setq list2 list1))))
- (dolist (elt list2)
- (unless (memq elt list1)
- (push elt list1)))
- (setcar groups list1)))
-
- ;; PLN Sat Jun 30 17:24:42 2007 : when a new
- ;; doc is specified, simply replaces the old one.
- (when doc
- ;;(message "Documentation redefined to %s" doc)
- (setcar (nthcdr num (eieio--class-class-allocation-doc newc))
- doc))
- ;; End PLN
-
- ;; If a new printer is specified, it simply replaces
- ;; the old one.
- (when print
- ;; (message "printer redefined to %s" print)
- (setcar (nthcdr num (eieio--class-class-allocation-printer newc)) print))
-
- ))
- ))
- ))
-
-(defun eieio-copy-parents-into-subclass (newc _parents)
+ (if (not cold)
+ (progn
+ (eieio--perform-slot-validation-for-default slot skipnil)
+ ;; Here we have found a :class version of a slot. This
+ ;; requires a very different approach.
+ (push slot (eieio--class-class-slots newc)))
+ (when defaultoverride
+ ;; There is a match, and we must override the old value.
+ (eieio--slot-override cold slot skipnil))))))
+
+(defun eieio-copy-parents-into-subclass (newc)
"Copy into NEWC the slots of PARENTS.
Follow the rules of not overwriting early parents when applying to
the new child class."
(let ((sn (eieio--class-option-assoc (eieio--class-options newc)
:allow-nil-initform)))
- (dolist (pcv (eieio--class-parent newc))
+ (dolist (pcv (eieio--class-parents newc))
;; First, duplicate all the slots of the parent.
- (let ((pa (eieio--class-public-a pcv))
- (pd (eieio--class-public-d pcv))
- (pdoc (eieio--class-public-doc pcv))
- (ptype (eieio--class-public-type pcv))
- (pcust (eieio--class-public-custom pcv))
- (plabel (eieio--class-public-custom-label pcv))
- (pcustg (eieio--class-public-custom-group pcv))
- (printer (eieio--class-public-printer pcv))
- (pprot (eieio--class-protection pcv))
- (pinit (eieio--class-initarg-tuples pcv))
- (i 0))
- (while pa
- (eieio--add-new-slot newc
- (car pa) (car pd) (car pdoc) (aref ptype i)
- (car pcust) (car plabel) (car pcustg)
- (car printer)
- (car pprot) (car-safe (car pinit)) nil nil sn)
+ (let ((pslots (eieio--class-slots pcv))
+ (pinit (eieio--class-initarg-tuples pcv)))
+ (dotimes (i (length pslots))
+ (eieio--add-new-slot newc (cl--copy-slot-descriptor (aref pslots i))
+ (car-safe (car pinit)) nil nil sn)
;; Increment each value.
- (setq pa (cdr pa)
- pd (cdr pd)
- pdoc (cdr pdoc)
- i (1+ i)
- pcust (cdr pcust)
- plabel (cdr plabel)
- pcustg (cdr pcustg)
- printer (cdr printer)
- pprot (cdr pprot)
- pinit (cdr pinit))
+ (setq pinit (cdr pinit))
)) ;; while/let
;; Now duplicate all the class alloc slots.
- (let ((pa (eieio--class-class-allocation-a pcv))
- (pdoc (eieio--class-class-allocation-doc pcv))
- (ptype (eieio--class-class-allocation-type pcv))
- (pcust (eieio--class-class-allocation-custom pcv))
- (plabel (eieio--class-class-allocation-custom-label pcv))
- (pcustg (eieio--class-class-allocation-custom-group pcv))
- (printer (eieio--class-class-allocation-printer pcv))
- (pprot (eieio--class-class-allocation-protection pcv))
- (pval (eieio--class-class-allocation-values pcv))
- (i 0))
- (while pa
- (eieio--add-new-slot newc
- (car pa) (aref pval i) (car pdoc) (aref ptype i)
- (car pcust) (car plabel) (car pcustg)
- (car printer)
- (car pprot) nil :class sn)
- ;; Increment each value.
- (setq pa (cdr pa)
- pdoc (cdr pdoc)
- pcust (cdr pcust)
- plabel (cdr plabel)
- pcustg (cdr pcustg)
- printer (cdr printer)
- pprot (cdr pprot)
- i (1+ i))
+ (let ((pcslots (eieio--class-class-slots pcv)))
+ (dotimes (i (length pcslots))
+ (eieio--add-new-slot newc (cl--copy-slot-descriptor
+ (aref pcslots i))
+ nil :class sn)
)))))
\f
nil
;; Trim off object IDX junk added in for the object index.
(setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots)))
- (let ((st (aref (eieio--class-public-type class) slot-idx)))
+ (let ((st (cl--slot-descriptor-type (aref (eieio--class-slots class)
+ slot-idx))))
(if (not (eieio--perform-slot-validation st value))
(signal 'invalid-slot-type
- (list (eieio--class-symbol class) slot st value))))))
+ (list (eieio--class-name class) slot st value))))))
(defun eieio--validate-class-slot-value (class slot-idx value slot)
"Make sure that for CLASS referencing SLOT-IDX, VALUE is valid.
an error."
(if eieio-skip-typecheck
nil
- (let ((st (aref (eieio--class-class-allocation-type class)
- slot-idx)))
+ (let ((st (cl--slot-descriptor-type (aref (eieio--class-class-slots class)
+ slot-idx))))
(if (not (eieio--perform-slot-validation st value))
(signal 'invalid-slot-type
- (list (eieio--class-symbol class) slot st value))))))
+ (list (eieio--class-name class) slot st value))))))
(defun eieio-barf-if-slot-unbound (value instance slotname fn)
"Throw a signal if VALUE is a representation of an UNBOUND slot.
slot. If the slot is ok, return VALUE.
Argument FN is the function calling this verifier."
(if (and (eq value eieio-unbound) (not eieio-skip-typecheck))
- (slot-unbound instance (eieio--object-class-name instance) slotname fn)
+ (slot-unbound instance (eieio--object-class instance) slotname fn)
value))
\f
(let ((c (eieio--class-v obj)))
(if (eieio--class-p c) (eieio-class-un-autoload obj))
c))
- (t (eieio--object-class-object obj))))
- (c (eieio--slot-name-index class obj slot)))
+ (t (eieio--object-class obj))))
+ (c (eieio--slot-name-index class slot)))
(if (not c)
;; It might be missing because it is a :class allocated slot.
;; Let's check that info out.
(cl-check-type obj (or eieio-object class))
(cl-check-type slot symbol)
(let* ((cl (cond ((symbolp obj) (eieio--class-v obj))
- (t (eieio--object-class-object obj))))
- (c (eieio--slot-name-index cl obj slot)))
+ (t (eieio--object-class obj))))
+ (c (eieio--slot-name-index cl slot)))
(if (not c)
;; It might be missing because it is a :class allocated slot.
;; Let's check that info out.
;;(signal 'invalid-slot-name (list (class-name cl) slot))
)
(eieio-barf-if-slot-unbound
- (let ((val (nth (- c (eval-when-compile eieio--object-num-slots))
- (eieio--class-public-d cl))))
+ (let ((val (cl--slot-descriptor-initform
+ (aref (eieio--class-slots cl)
+ (- c (eval-when-compile eieio--object-num-slots))))))
(eieio-default-eval-maybe val))
- obj (eieio--class-symbol cl) 'oref-default))))
+ obj (eieio--class-name cl) 'oref-default))))
(defun eieio-default-eval-maybe (val)
"Check VAL, and return what `oref-default' would provide."
Fills in OBJ's SLOT with VALUE."
(cl-check-type obj eieio-object)
(cl-check-type slot symbol)
- (let* ((class (eieio--object-class-object obj))
- (c (eieio--slot-name-index class obj slot)))
+ (let* ((class (eieio--object-class obj))
+ (c (eieio--slot-name-index class slot)))
(if (not c)
;; It might be missing because it is a :class allocated slot.
;; Let's check that info out.
(setq class (eieio--class-object class))
(cl-check-type class eieio--class)
(cl-check-type slot symbol)
- (let* ((c (eieio--slot-name-index class nil slot)))
+ (let* ((c (eieio--slot-name-index class slot)))
(if (not c)
;; It might be missing because it is a :class allocated slot.
;; Let's check that info out.
(eieio--validate-class-slot-value class c value slot)
(aset (eieio--class-class-allocation-values class) c
value))
- (signal 'invalid-slot-name (list (eieio--class-symbol class) slot)))
+ (signal 'invalid-slot-name (list (eieio--class-name class) slot)))
+ ;; `oset-default' on an instance-allocated slot is allowed by EIEIO but
+ ;; not by CLOS and is mildly inconsistent with the :initform thingy, so
+ ;; it'd be nice to get of it. This said, it is/was used at one place by
+ ;; gnus/registry.el, so it might be used elsewhere as well, so let's
+ ;; keep it for now.
+ ;; FIXME: Generate a compile-time warning for it!
+ ;; (error "Can't `oset-default' an instance-allocated slot: %S of %S"
+ ;; slot class)
(eieio--validate-slot-value class c value slot)
;; Set this into the storage for defaults.
- (setcar (nthcdr (- c (eval-when-compile eieio--object-num-slots))
- (eieio--class-public-d class))
+ (if (eieio-eval-default-p value)
+ (error "Can't set default to a sexp that gets evaluated again"))
+ (setf (cl--slot-descriptor-initform
+ ;; FIXME: Apparently we set it both in `slots' and in
+ ;; `object-cache', which seems redundant.
+ (aref (eieio--class-slots class)
+ (- c (eval-when-compile eieio--object-num-slots))))
value)
;; Take the value, and put it into our cache object.
(eieio-oset (eieio--class-default-object-cache class)
\f
;;; EIEIO internal search functions
;;
-(defun eieio--slot-name-index (class obj slot)
- "In CLASS for OBJ find the index of the named SLOT.
-The slot is a symbol which is installed in CLASS by the `defclass'
-call. OBJ can be nil, but if it is an object, and the slot in question
-is protected, access will be allowed if OBJ is a child of the currently
-scoped class.
+(defun eieio--slot-name-index (class slot)
+ "In CLASS find the index of the named SLOT.
+The slot is a symbol which is installed in CLASS by the `defclass' call.
If SLOT is the value created with :initarg instead,
reverse-lookup that name, and recurse with the associated slot value."
;; Removed checks to outside this call
- (let* ((fsym (gethash slot (eieio--class-symbol-hashtable class)))
- (fsi (car fsym)))
+ (let* ((fsi (gethash slot (eieio--class-index-table class))))
(if (integerp fsi)
(+ (eval-when-compile eieio--object-num-slots) fsi)
(let ((fn (eieio--initarg-to-attribute class slot)))
- (if fn (eieio--slot-name-index class obj fn) nil)))))
+ (if fn
+ ;; Accessing a slot via its :initarg is accepted by EIEIO
+ ;; (but not CLOS) but is a bad idea (for one: it's slower).
+ ;; FIXME: We should emit a compile-time warning when this happens!
+ (eieio--slot-name-index class fn)
+ nil)))))
(defun eieio--class-slot-name-index (class slot)
"In CLASS find the index of the named SLOT.
reverse-lookup that name, and recurse with the associated slot value."
;; This will happen less often, and with fewer slots. Do this the
;; storage cheap way.
- (let* ((a (eieio--class-class-allocation-a class))
- (l1 (length a))
- (af (memq slot a))
- (l2 (length af)))
- ;; Slot # is length of the total list, minus the remaining list of
- ;; the found slot.
- (if af (- l1 l2))))
+ (let ((index nil)
+ (slots (eieio--class-class-slots class)))
+ (dotimes (i (length slots))
+ (if (eq slot (cl--slot-descriptor-name (aref slots i)))
+ (setq index i)))
+ index))
;;;
;; Way to assign slots based on a list. Used for constructors, or
If SET-ALL is non-nil, then when a default is nil, that value is
reset. If SET-ALL is nil, the slots are only reset if the default is
not nil."
- (let ((pub (eieio--class-public-a (eieio--object-class-object obj))))
- (while pub
- (let ((df (eieio-oref-default obj (car pub))))
+ (let ((slots (eieio--class-slots (eieio--object-class obj))))
+ (dotimes (i (length slots))
+ (let* ((name (cl--slot-descriptor-name (aref slots i)))
+ (df (eieio-oref-default obj name)))
(if (or df set-all)
- (eieio-oset obj (car pub) df)))
- (setq pub (cdr pub)))))
+ (eieio-oset obj name df))))))
(defun eieio--initarg-to-attribute (class initarg)
"For CLASS, convert INITARG to the actual attribute name.
(defun eieio--c3-merge-lists (reversed-partial-result remaining-inputs)
"Merge REVERSED-PARTIAL-RESULT REMAINING-INPUTS in a consistent order, if possible.
If a consistent order does not exist, signal an error."
- (if (let ((tail remaining-inputs)
- (found nil))
- (while (and tail (not found))
- (setq found (car tail) tail (cdr tail)))
- (not found))
+ (setq remaining-inputs (delq nil remaining-inputs))
+ (if (null remaining-inputs)
;; If all remaining inputs are empty lists, we are done.
(nreverse reversed-partial-result)
;; Otherwise, we try to find the next element of the result. This
(tail remaining-inputs)
(next (progn
(while (and tail (not found))
- (setq found (and (car tail)
- (eieio--c3-candidate (caar tail)
- remaining-inputs))
+ (setq found (eieio--c3-candidate (caar tail)
+ remaining-inputs)
tail (cdr tail)))
found)))
(if next
;; The graph is inconsistent, give up
(signal 'inconsistent-class-hierarchy (list remaining-inputs))))))
+(defsubst eieio--class/struct-parents (class)
+ (or (eieio--class-parents class)
+ `(,eieio-default-superclass)))
+
(defun eieio--class-precedence-c3 (class)
"Return all parents of CLASS in c3 order."
- (let ((parents (eieio--class-parent (eieio--class-v class))))
+ (let ((parents (eieio--class-parents (eieio--class-v class))))
(eieio--c3-merge-lists
(list class)
(append
(defun eieio--class-precedence-dfs (class)
"Return all parents of CLASS in depth-first order."
- (let* ((parents (eieio--class-parent class))
+ (let* ((parents (eieio--class-parents class))
(classes (copy-sequence
(apply #'append
(list class)
(defun eieio--class-precedence-bfs (class)
"Return all parents of CLASS in breadth-first order."
(let* ((result)
- (queue (or (eieio--class-parent class)
- `(,eieio-default-superclass))))
+ (queue (eieio--class/struct-parents class)))
(while queue
(let ((head (pop queue)))
(unless (member head result)
(push head result)
(unless (eq head eieio-default-superclass)
- (setq queue (append queue (or (eieio--class-parent head)
- `(,eieio-default-superclass))))))))
+ (setq queue (append queue (eieio--class/struct-parents head)))))))
(cons class (nreverse result)))
)
(if (or (null class) (eq class eieio-default-superclass))
nil
(unless (eieio--class-default-object-cache class)
- (eieio-class-un-autoload (eieio--class-symbol class)))
+ (eieio-class-un-autoload (eieio--class-name class)))
(cl-case (eieio--class-method-invocation-order class)
(:depth-first
(eieio--class-precedence-dfs class))
;;;; General support to dispatch based on the type of the argument.
-(add-function :before-until cl-generic-tagcode-function
- #'eieio--generic-tagcode)
-(defun eieio--generic-tagcode (type name)
+(defconst eieio--generic-generalizer
+ (cl-generic-make-generalizer
+ ;; Use the exact same tagcode as for cl-struct, so that methods
+ ;; that dispatch on both kinds of objects get to share this
+ ;; part of the dispatch code.
+ 50 #'cl--generic-struct-tag
+ (lambda (tag)
+ (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag))
+ (mapcar #'eieio--class-name
+ (eieio--class-precedence-list (symbol-value tag)))))))
+
+(cl-defmethod cl-generic-generalizers :extra "class" (specializer)
;; CLHS says:
;; A class must be defined before it can be used as a parameter
;; specializer in a defmethod form.
;; So we can ignore types that are not known to denote classes.
- (and (eieio--class-p (eieio--class-object type))
- ;; Use the exact same code as for cl-struct, so that methods
- ;; that dispatch on both kinds of objects get to share this
- ;; part of the dispatch code.
- `(50 . ,(cl--generic-struct-tag name))))
-
-(add-function :before-until cl-generic-tag-types-function
- #'eieio--generic-tag-types)
-(defun eieio--generic-tag-types (tag)
- (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag))
- (mapcar #'eieio--class-symbol
- (eieio--class-precedence-list (symbol-value tag)))))
+ (or
+ (and (eieio--class-p (eieio--class-object specializer))
+ (list eieio--generic-generalizer))
+ (cl-call-next-method)))
;;;; Dispatch for arguments which are classes.
;; would not make much sense (e.g. to which argument should it apply?).
;; Instead, we add a new "subclass" specializer.
-(add-function :before-until cl-generic-tagcode-function
- #'eieio--generic-subclass-tagcode)
-(defun eieio--generic-subclass-tagcode (type name)
- (when (eq 'subclass (car-safe type))
- `(60 . (and (symbolp ,name) (eieio--class-v ,name)))))
-
-(add-function :before-until cl-generic-tag-types-function
- #'eieio--generic-subclass-tag-types)
-(defun eieio--generic-subclass-tag-types (tag)
+(defun eieio--generic-subclass-specializers (tag)
(when (eieio--class-p tag)
(mapcar (lambda (class)
- `(subclass
- ,(if (symbolp class) class (eieio--class-symbol class))))
+ `(subclass ,(eieio--class-name class)))
(eieio--class-precedence-list tag))))
+(defconst eieio--generic-subclass-generalizer
+ (cl-generic-make-generalizer
+ 60 (lambda (name) `(and (symbolp ,name) (eieio--class-v ,name)))
+ #'eieio--generic-subclass-specializers))
+
+(cl-defmethod cl-generic-generalizers ((_specializer (head subclass)))
+ (list eieio--generic-subclass-generalizer))
+
\f
-;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "b568ffb3c90ed5d0ae673f0051d608ee")
+;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "0609a7bdcd6f38876b7f5647047ddca9")
;;; Generated autoloads from eieio-compat.el
(autoload 'eieio--defalias "eieio-compat" "\
(let* ((chil nil)
(obj (widget-get widget :value))
(master-group (widget-get widget :eieio-group))
- (cv (eieio--object-class-object obj))
- (slots (eieio--class-public-a cv))
- (flabel (eieio--class-public-custom-label cv))
- (fgroup (eieio--class-public-custom-group cv))
- (fdoc (eieio--class-public-doc cv))
- (fcust (eieio--class-public-custom cv)))
+ (cv (eieio--object-class obj))
+ (slots (eieio--class-slots cv)))
;; First line describes the object, but may not editable.
(if (widget-get widget :eieio-show-name)
(setq chil (cons (widget-create-child-and-convert
chil)))
;; Display information about the group being shown
(when master-group
- (let ((groups (eieio--class-option (eieio--object-class-object obj)
+ (let ((groups (eieio--class-option (eieio--object-class obj)
:custom-groups)))
(widget-insert "Groups:")
(while groups
(setq groups (cdr groups)))
(widget-insert "\n\n")))
;; Loop over all the slots, creating child widgets.
- (while slots
- ;; Output this slot if it has a customize flag associated with it.
- (when (and (car fcust)
- (or (not master-group) (member master-group (car fgroup)))
- (slot-boundp obj (car slots)))
- ;; In this case, this slot has a custom type. Create its
- ;; children widgets.
- (let ((type (eieio-filter-slot-type widget (car fcust)))
- (stuff nil))
- ;; This next bit is an evil hack to get some EDE functions
- ;; working the way I like.
- (if (and (listp type)
- (setq stuff (member :slotofchoices type)))
- (let ((choices (eieio-oref obj (car (cdr stuff))))
- (newtype nil))
- (while (not (eq (car type) :slotofchoices))
- (setq newtype (cons (car type) newtype)
- type (cdr type)))
- (while choices
- (setq newtype (cons (list 'const (car choices))
- newtype)
- choices (cdr choices)))
- (setq type (nreverse newtype))))
- (setq chil (cons (widget-create-child-and-convert
- widget 'object-slot
- :childtype type
- :sample-face 'eieio-custom-slot-tag-face
- :tag
- (concat
- (make-string
- (or (widget-get widget :indent) 0)
- ? )
- (if (car flabel)
- (car flabel)
- (let ((s (symbol-name
- (or
- (eieio--class-slot-initarg
- (eieio--object-class-object obj)
- (car slots))
- (car slots)))))
- (capitalize
- (if (string-match "^:" s)
- (substring s (match-end 0))
- s)))))
- :value (slot-value obj (car slots))
- :doc (if (car fdoc) (car fdoc)
- "Slot not Documented.")
- :eieio-custom-visibility 'visible
- )
- chil))
- )
- )
- (setq slots (cdr slots)
- fdoc (cdr fdoc)
- fcust (cdr fcust)
- flabel (cdr flabel)
- fgroup (cdr fgroup)))
+ (dotimes (i (length slots))
+ (let* ((slot (aref slots i))
+ (props (cl--slot-descriptor-props slot)))
+ ;; Output this slot if it has a customize flag associated with it.
+ (when (and (alist-get :custom props)
+ (or (not master-group)
+ (member master-group (alist-get :group props)))
+ (slot-boundp obj (cl--slot-descriptor-name slot)))
+ ;; In this case, this slot has a custom type. Create its
+ ;; children widgets.
+ (let ((type (eieio-filter-slot-type widget (alist-get :custom props)))
+ (stuff nil))
+ ;; This next bit is an evil hack to get some EDE functions
+ ;; working the way I like.
+ (if (and (listp type)
+ (setq stuff (member :slotofchoices type)))
+ (let ((choices (eieio-oref obj (car (cdr stuff))))
+ (newtype nil))
+ (while (not (eq (car type) :slotofchoices))
+ (setq newtype (cons (car type) newtype)
+ type (cdr type)))
+ (while choices
+ (setq newtype (cons (list 'const (car choices))
+ newtype)
+ choices (cdr choices)))
+ (setq type (nreverse newtype))))
+ (setq chil (cons (widget-create-child-and-convert
+ widget 'object-slot
+ :childtype type
+ :sample-face 'eieio-custom-slot-tag-face
+ :tag
+ (concat
+ (make-string
+ (or (widget-get widget :indent) 0)
+ ?\s)
+ (or (alist-get :label props)
+ (let ((s (symbol-name
+ (or
+ (eieio--class-slot-initarg
+ (eieio--object-class obj)
+ (car slots))
+ (car slots)))))
+ (capitalize
+ (if (string-match "^:" s)
+ (substring s (match-end 0))
+ s)))))
+ :value (slot-value obj (car slots))
+ :doc (or (alist-get :documentation props)
+ "Slot not Documented.")
+ :eieio-custom-visibility 'visible
+ )
+ chil))
+ ))))
(widget-put widget :children (nreverse chil))
))
"Get the value of WIDGET."
(let* ((obj (widget-get widget :value))
(master-group eieio-cog)
- (cv (eieio--object-class-object obj))
- (fgroup (eieio--class-public-custom-group cv))
(wids (widget-get widget :children))
(name (if (widget-get widget :eieio-show-name)
(car (widget-apply (car wids) :value-inline))
nil))
(chil (if (widget-get widget :eieio-show-name)
(nthcdr 1 wids) wids))
- (cv (eieio--object-class-object obj))
- (slots (eieio--class-public-a cv))
- (fcust (eieio--class-public-custom cv)))
+ (cv (eieio--object-class obj))
+ (i 0)
+ (slots (eieio--class-slots cv)))
;; If there are any prefix widgets, clear them.
;; -- None yet
;; Create a batch of initargs for each slot.
- (while (and slots chil)
- (if (and (car fcust)
- (or eieio-custom-ignore-eieio-co
- (not master-group) (member master-group (car fgroup)))
- (slot-boundp obj (car slots)))
- (progn
- ;; Only customized slots have widgets
- (let ((eieio-custom-ignore-eieio-co t))
- (eieio-oset obj (car slots)
- (car (widget-apply (car chil) :value-inline))))
- (setq chil (cdr chil))))
- (setq slots (cdr slots)
- fgroup (cdr fgroup)
- fcust (cdr fcust)))
+ (while (and (< i (length slots)) chil)
+ (let* ((slot (aref slots i))
+ (props (cl--slot-descriptor-props slot))
+ (cust (alist-get :custom props)))
+ (if (and cust
+ (or eieio-custom-ignore-eieio-co
+ (not master-group)
+ (member master-group (alist-get :group props)))
+ (slot-boundp obj (cl--slot-descriptor-name slot)))
+ (progn
+ ;; Only customized slots have widgets
+ (let ((eieio-custom-ignore-eieio-co t))
+ (eieio-oset obj (cl--slot-descriptor-name slot)
+ (car (widget-apply (car chil) :value-inline))))
+ (setq chil (cdr chil))))))
;; Set any name updates on it.
(if name (eieio-object-set-name-string obj name))
;; This is the same object we had before.
(vector (concat "Group " (symbol-name group))
(list 'customize-object obj (list 'quote group))
t))
- (eieio--class-option (eieio--object-class-object obj) :custom-groups)))
+ (eieio--class-option (eieio--object-class obj) :custom-groups)))
(defvar eieio-read-custom-group-history nil
"History for the custom group reader.")
(cl-defmethod eieio-read-customization-group ((obj eieio-default-superclass))
"Do a completing read on the name of a customization group in OBJ.
Return the symbol for the group, or nil"
- (let ((g (eieio--class-option (eieio--object-class-object obj)
+ (let ((g (eieio--class-option (eieio--object-class obj)
:custom-groups)))
(if (= (length g) 1)
(car g)
;;; Code:
+(declare-function data-debug/eieio-insert-slots "eieio-datadebug"
+ (obj eieio-default-superclass))
+
(defun data-debug-insert-object-slots (object prefix)
"Insert all the slots of OBJECT.
PREFIX specifies what to insert at the start of each line."
"Insert a button representing OBJECT.
PREFIX is the text that precedes the button.
PREBUTTONTEXT is some text between PREFIX and the object button."
- (let ((start (point))
- (end nil)
- (str (object-print object))
- (tip (format "Object %s\nClass: %S\nParent(s): %S\n%d slots"
- (eieio-object-name-string object)
- (eieio-object-class object)
- (eieio-class-parents (eieio-object-class object))
- (length (object-slots object))
- ))
- )
+ (let* ((start (point))
+ (end nil)
+ (str (object-print object))
+ (class (eieio-object-class object))
+ (tip (format "Object %s\nClass: %S\nParent(s): %S\n%d slots"
+ (eieio-object-name-string object)
+ class
+ (eieio-class-parents class)
+ (length (eieio-class-slots class))
+ ))
+ )
(insert prefix prebuttontext str)
(setq end (point))
(put-text-property (- end (length str)) end 'face 'font-lock-keyword-face)
;; Each object should have an opportunity to show stuff about itself.
(cl-defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass)
- prefix)
+ prefix)
"Insert the slots of OBJ into the current DDEBUG buffer."
(let ((inhibit-read-only t))
(data-debug-insert-thing (eieio-object-name-string obj)
prefix
"Name: ")
- (let* ((cl (eieio-object-class obj))
- (cv (eieio--class-v cl)))
- (data-debug-insert-thing (eieio--class-constructor cl)
+ (let* ((cv (eieio--object-class obj)))
+ (data-debug-insert-thing (eieio--class-name cv)
prefix
"Class: ")
;; Loop over all the public slots
- (let ((publa (eieio--class-public-a cv))
- )
- (while publa
- (if (slot-boundp obj (car publa))
- (let* ((i (eieio--class-slot-initarg (eieio--class-v cl)
- (car publa)))
- (v (eieio-oref obj (car publa))))
- (data-debug-insert-thing
- v prefix (concat
- (if i (symbol-name i)
- (symbol-name (car publa)))
- " ")))
- ;; Unbound case
- (let ((i (eieio--class-slot-initarg (eieio--class-v cl)
- (car publa))))
- (data-debug-insert-custom
- "#unbound" prefix
- (concat (if i (symbol-name i)
- (symbol-name (car publa)))
- " ")
- 'font-lock-keyword-face))
- )
- (setq publa (cdr publa)))))))
+ (let ((slots (eieio--class-slots cv)))
+ (dotimes (i (length slots))
+ (let* ((slot (aref slots i))
+ (sname (cl--slot-descriptor-name slot))
+ (i (eieio--class-slot-initarg cv sname))
+ (sstr (concat (symbol-name (or i sname)) " ")))
+ (if (slot-boundp obj sname)
+ (let* ((v (eieio-oref obj sname)))
+ (data-debug-insert-thing v prefix sstr))
+ ;; Unbound case
+ (data-debug-insert-custom
+ "#unbound" prefix sstr
+ 'font-lock-keyword-face)
+ )))))))
;;; Augment the Data debug thing display list.
(data-debug-add-specialized-thing (lambda (thing) (eieio-object-p thing))
(when pl
(insert " Inherits from ")
(while (setq cur (pop pl))
+ (setq cur (eieio--class-name cur))
(insert "`")
(help-insert-xref-button (symbol-name cur)
'help-function cur)
(or doc "")))
(insert "\n\n")))))
+(defun eieio--help-print-slot (slot)
+ (insert
+ (concat
+ (propertize "Slot: " 'face 'bold)
+ (prin1-to-string (cl--slot-descriptor-name slot))
+ (unless (eq (cl--slot-descriptor-type slot) t)
+ (concat " type = "
+ (prin1-to-string (cl--slot-descriptor-type slot))))
+ (unless (eq (cl--slot-descriptor-initform slot) eieio-unbound)
+ (concat " default = "
+ (prin1-to-string (cl--slot-descriptor-initform slot))))
+ (when (alist-get :printer (cl--slot-descriptor-props slot))
+ (concat " printer = "
+ (prin1-to-string
+ (alist-get :printer (cl--slot-descriptor-props slot)))))
+ (when (alist-get :documentation (cl--slot-descriptor-props slot))
+ (concat "\n " (alist-get :documentation (cl--slot-descriptor-props slot))
+ "\n")))
+ "\n"))
+
(defun eieio-help-class-slots (class)
"Print help description for the slots in CLASS.
Outputs to the current buffer."
(let* ((cv (eieio--class-v class))
- (docs (eieio--class-public-doc cv))
- (names (eieio--class-public-a cv))
- (deflt (eieio--class-public-d cv))
- (types (eieio--class-public-type cv))
- (publp (eieio--class-public-printer cv))
- (i 0)
- (prot (eieio--class-protection cv))
- )
+ (slots (eieio--class-slots cv))
+ (cslots (eieio--class-class-slots cv)))
(insert (propertize "Instance Allocated Slots:\n\n"
'face 'bold))
- (while names
- (insert
- (concat
- (when (car prot)
- (propertize "Private " 'face 'bold))
- (propertize "Slot: " 'face 'bold)
- (prin1-to-string (car names))
- (unless (eq (aref types i) t)
- (concat " type = "
- (prin1-to-string (aref types i))))
- (unless (eq (car deflt) eieio-unbound)
- (concat " default = "
- (prin1-to-string (car deflt))))
- (when (car publp)
- (concat " printer = "
- (prin1-to-string (car publp))))
- (when (car docs)
- (concat "\n " (car docs) "\n"))
- "\n"))
- (setq names (cdr names)
- docs (cdr docs)
- deflt (cdr deflt)
- publp (cdr publp)
- prot (cdr prot)
- i (1+ i)))
- (setq docs (eieio--class-class-allocation-doc cv)
- names (eieio--class-class-allocation-a cv)
- types (eieio--class-class-allocation-type cv)
- i 0
- prot (eieio--class-class-allocation-protection cv))
- (when names
+ (dotimes (i (length slots))
+ (eieio--help-print-slot (aref slots i)))
+ (when (> (length cslots) 0)
(insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold)))
- (while names
- (insert
- (concat
- (when (car prot)
- "Private ")
- "Slot: "
- (prin1-to-string (car names))
- (unless (eq (aref types i) t)
- (concat " type = "
- (prin1-to-string (aref types i))))
- (condition-case nil
- (let ((value (eieio-oref class (car names))))
- (concat " value = "
- (prin1-to-string value)))
- (error nil))
- (when (car docs)
- (concat "\n\n " (car docs) "\n"))
- "\n"))
- (setq names (cdr names)
- docs (cdr docs)
- prot (cdr prot)
- i (1+ i)))))
+ (dotimes (i (length cslots))
+ (eieio--help-print-slot (aref cslots i)))))
(defun eieio-build-class-alist (&optional class instantiable-only buildlist)
"Return an alist of all currently active classes for completion purposes.
(error "Method invocation order %s is not allowed" io)))
(let ((testsym1 (intern (concat (symbol-name name) "-p")))
- (testsym2 (intern (format "eieio--childp--%s" name)))
+ (testsym2 (intern (format "%s--eieio-childp" name)))
(accessors ()))
;; Collect the accessors we need to define.
;; but hide it so we don't trigger indefinitely.
`(,(car whole) (identity ,(car slots))
,@(cdr slots)))))))
- (apply #'eieio-constructor ',name slots))))))
+ (apply #'make-instance ',name slots))))))
-;;; CLOS style implementation of object creators.
-;;
-(defun make-instance (class &rest initargs)
- "Make a new instance of CLASS based on INITARGS.
-CLASS is a class symbol. For example:
-
- (make-instance 'foo)
-
- INITARGS is a property list with keywords based on the :initarg
-for each slot. For example:
-
- (make-instance 'foo :slot1 value1 :slotN valueN)
-
-Compatibility note:
-
-If the first element of INITARGS is a string, it is used as the
-name of the class.
-
-In EIEIO, the class' constructor requires a name for use when printing.
-`make-instance' in CLOS doesn't use names the way Emacs does, so the
-class is used as the name slot instead when INITARGS doesn't start with
-a string."
- (apply (eieio--class-constructor class) initargs))
-
-\f
;;; Get/Set slots in an object.
;;
(defmacro oref (obj slot)
(defalias 'slot-value 'eieio-oref)
(defalias 'set-slot-value 'eieio-oset)
+(make-obsolete 'set-slot-value "use (setf (slot-value ..) ..) instead" "25.1")
(defmacro oref-default (obj slot)
"Get the default value of OBJ (maybe a class) for SLOT.
(declare (indent 2) (debug (sexp sexp def-body)))
(require 'cl-lib)
;; Transform the spec-list into a cl-symbol-macrolet spec-list.
- (let ((mappings (mapcar (lambda (entry)
- (let ((var (if (listp entry) (car entry) entry))
- (slot (if (listp entry) (cadr entry) entry)))
- (list var `(slot-value ,object ',slot))))
- spec-list)))
- (append (list 'cl-symbol-macrolet mappings)
- body)))
+ (macroexp-let2 nil object object
+ `(cl-symbol-macrolet
+ ,(mapcar (lambda (entry)
+ (let ((var (if (listp entry) (car entry) entry))
+ (slot (if (listp entry) (cadr entry) entry)))
+ (list var `(slot-value ,object ',slot))))
+ spec-list)
+ ,@body)))
+
+;; Keep it as a non-inlined function, so the internals of object don't get
+;; hard-coded in random .elc files.
+(defun eieio-pcase-slot-index-table (obj)
+ "Return some data structure from which can be extracted the slot offset."
+ (eieio--class-index-table
+ (symbol-value (eieio--object-class-tag obj))))
+
+(defun eieio-pcase-slot-index-from-index-table (index-table slot)
+ "Find the index to pass to `aref' to access SLOT."
+ (let ((index (gethash slot index-table)))
+ (if index (+ (eval-when-compile
+ (length (cl-struct-slot-info 'eieio--object)))
+ index))))
+
+(pcase-defmacro eieio (&rest fields)
+ "Pcase patterns to match EIEIO objects.
+Elements of FIELDS can be of the form (NAME UPAT) in which case the contents of
+field NAME is matched against UPAT, or they can be of the form NAME which
+is a shorthand for (NAME NAME)."
+ (let ((is (make-symbol "table")))
+ ;; FIXME: This generates a horrendous mess of redundant let bindings.
+ ;; `pcase' needs to be improved somehow to introduce let-bindings more
+ ;; sparingly, or the byte-compiler needs to be taught to optimize
+ ;; them away.
+ ;; FIXME: `pcase' does not do a good job here of sharing tests&code among
+ ;; various branches.
+ `(and (pred eieio-object-p)
+ (app eieio-pcase-slot-index-table ,is)
+ ,@(mapcar (lambda (field)
+ (let* ((name (if (consp field) (car field) field))
+ (pat (if (consp field) (cadr field) field))
+ (i (make-symbol "index")))
+ `(and (let (and ,i (pred natnump))
+ (eieio-pcase-slot-index-from-index-table
+ ,is ',name))
+ (app (pcase--flip aref ,i) ,pat))))
+ fields))))
\f
;;; Simple generators, and query functions. None of these would do
;; well embedded into an object.
;;
+
(define-obsolete-function-alias
- 'object-class-fast #'eieio--object-class-name "24.4")
+ 'object-class-fast #'eieio-object-class "24.4")
(cl-defgeneric eieio-object-name-string (obj)
"Return a string which is OBJ's name."
(declare (obsolete eieio-named "25.1")))
(defun eieio-object-name (obj &optional extra)
- "Return a Lisp like symbol string for object OBJ.
+ "Return a printed representation for object OBJ.
If EXTRA, include that in the string returned to represent the symbol."
(cl-check-type obj eieio-object)
- (format "#<%s %s%s>" (eieio--object-class-name obj)
+ (format "#<%s %s%s>" (eieio-object-class obj)
(eieio-object-name-string obj) (or extra "")))
(define-obsolete-function-alias 'object-name #'eieio-object-name "24.4")
"Return the class struct defining OBJ."
;; FIXME: We say we return a "struct" but we return a symbol instead!
(cl-check-type obj eieio-object)
- (eieio--object-class-name obj))
+ (eieio--class-name (eieio--object-class obj)))
(define-obsolete-function-alias 'object-class #'eieio-object-class "24.4")
;; CLOS name, maybe?
(define-obsolete-function-alias 'class-of #'eieio-object-class "24.4")
(defun eieio-object-class-name (obj)
"Return a Lisp like symbol name for OBJ's class."
(cl-check-type obj eieio-object)
- (eieio-class-name (eieio--object-class-name obj)))
+ (eieio-class-name (eieio--object-class obj)))
(define-obsolete-function-alias
'object-class-name 'eieio-object-class-name "24.4")
"Return parent classes to CLASS. (overload of variable).
The CLOS function `class-direct-superclasses' is aliased to this function."
- (eieio--class-parent (eieio--class-object class)))
+ (eieio--class-parents (eieio--class-object class)))
(define-obsolete-function-alias 'class-parents #'eieio-class-parents "24.4")
(setq class (eieio--class-object class))
(cl-check-type class eieio--class)
(cl-check-type obj eieio-object)
- (eq (eieio--object-class-object obj) class))
+ (eq (eieio--object-class obj) class))
(defun object-of-class-p (obj class)
"Return non-nil if OBJ is an instance of CLASS or CLASS' subclasses."
(cl-check-type obj eieio-object)
;; class will be checked one layer down
- (child-of-class-p (eieio--object-class-object obj) class))
+ (child-of-class-p (eieio--object-class obj) class))
;; Backwards compatibility
(defalias 'obj-of-class-p 'object-of-class-p)
"Return non-nil if CHILD class is a subclass of CLASS."
(setq child (eieio--class-object child))
(cl-check-type child eieio--class)
- ;; `eieio-default-superclass' is never mentioned in eieio--class-parent,
+ ;; `eieio-default-superclass' is never mentioned in eieio--class-parents,
;; so we have to special case it here.
(or (eq class 'eieio-default-superclass)
(let ((p nil))
(setq class (eieio--class-object class))
(cl-check-type class eieio--class)
(while (and child (not (eq child class)))
- (setq p (append p (eieio--class-parent child))
+ (setq p (append p (eieio--class-parents child))
child (pop p)))
(if child t))))
+(defun eieio-slot-descriptor-name (slot)
+ (cl--slot-descriptor-name slot))
+
+(defun eieio-class-slots (class)
+ "Return list of slots available in instances of CLASS."
+ ;; FIXME: This only gives the instance slots and ignores the
+ ;; class-allocated slots.
+ (setq class (eieio--class-object class))
+ (cl-check-type class eieio--class)
+ (mapcar #'identity (eieio--class-slots class)))
+
(defun object-slots (obj)
- "Return list of slots available in OBJ."
+ "Return list of slot names available in OBJ."
+ (declare (obsolete eieio-class-slots "25.1"))
(cl-check-type obj eieio-object)
- (eieio--class-public-a (eieio--object-class-object obj)))
+ (mapcar #'cl--slot-descriptor-name
+ (eieio-class-slots (eieio--object-class obj))))
-(defun eieio--class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg."
+(defun eieio--class-slot-initarg (class slot)
+ "Fetch from CLASS, SLOT's :initarg."
(cl-check-type class eieio--class)
(let ((ia (eieio--class-initarg-tuples class))
(f nil))
(defun slot-exists-p (object-or-class slot)
"Return non-nil if OBJECT-OR-CLASS has SLOT."
(let ((cv (cond ((eieio-object-p object-or-class)
- (eieio--object-class-object object-or-class))
+ (eieio--object-class object-or-class))
((eieio--class-p object-or-class) object-or-class)
(t (find-class object-or-class 'error)))))
- (or (memq slot (eieio--class-public-a cv))
- (memq slot (eieio--class-class-allocation-a cv)))
- ))
+ (or (gethash slot (eieio--class-index-table cv))
+ ;; FIXME: We could speed this up by adding class slots into the
+ ;; index-table (e.g. with a negative index?).
+ (let ((cs (eieio--class-class-slots cv))
+ found)
+ (dotimes (i (length cs))
+ (if (eq slot (cl--slot-descriptor-name (aref cs i)))
+ (setq found t)))
+ found))))
(defun find-class (symbol &optional errorp)
"Return the class that SYMBOL represents.
;;; Here are some CLOS items that need the CL package
;;
+;; FIXME: Shouldn't this be a more complex gv-expander which extracts the
+;; common code between oref and oset, so as to reduce the redundant work done
+;; in (push foo (oref bar baz)), like we do for the `nth' expander?
(gv-define-simple-setter eieio-oref eieio-oset)
\f
(defalias 'standard-class 'eieio-default-superclass)
-(cl-defgeneric eieio-constructor (class &rest slots)
- "Default constructor for CLASS `eieio-default-superclass'.")
+(cl-defgeneric make-instance (class &rest initargs)
+ "Make a new instance of CLASS based on INITARGS.
+For example:
+
+ (make-instance 'foo)
+
+INITARGS is a property list with keywords based on the `:initarg'
+for each slot. For example:
+
+ (make-instance 'foo :slot1 value1 :slotN valueN)")
-(define-obsolete-function-alias 'constructor #'eieio-constructor "25.1")
+(define-obsolete-function-alias 'constructor #'make-instance "25.1")
-(cl-defmethod eieio-constructor
- ((class (subclass eieio-default-superclass)) &rest slots)
+(cl-defmethod make-instance
+ ((class (subclass eieio-default-superclass)) &rest slots)
"Default constructor for CLASS `eieio-default-superclass'.
-SLOTS are the initialization slots used by `shared-initialize'.
+SLOTS are the initialization slots used by `initialize-instance'.
This static method is called when an object is constructed.
It allocates the vector used to represent an EIEIO object, and then
-calls `shared-initialize' on that object."
+calls `initialize-instance' on that object."
(let* ((new-object (copy-sequence (eieio--class-default-object-cache
- (eieio--class-v class)))))
+ (eieio--class-object class)))))
(if (and slots
(let ((x (car slots)))
(or (stringp x) (null x))))
;; Return the created object.
new-object))
+;; FIXME: CLOS uses "&rest INITARGS" instead.
(cl-defgeneric shared-initialize (obj slots)
"Set slots of OBJ with SLOTS which is a list of name/value pairs.
Called from the constructor routine.")
"Set slots of OBJ with SLOTS which is a list of name/value pairs.
Called from the constructor routine."
(while slots
- (let ((rn (eieio--initarg-to-attribute (eieio--object-class-object obj)
+ (let ((rn (eieio--initarg-to-attribute (eieio--object-class obj)
(car slots))))
(if (not rn)
(slot-missing obj (car slots) 'oset (car (cdr slots)))
(eieio-oset obj rn (car (cdr slots)))))
(setq slots (cdr (cdr slots)))))
+;; FIXME: CLOS uses "&rest INITARGS" instead.
(cl-defgeneric initialize-instance (this &optional slots)
"Construct the new object THIS based on SLOTS.")
dynamically set from SLOTS."
;; First, see if any of our defaults are `lambda', and
;; re-evaluate them and apply the value to our slots.
- (let* ((this-class (eieio--object-class-object this))
- (slot (eieio--class-public-a this-class))
- (defaults (eieio--class-public-d this-class)))
- (while slot
+ (let* ((this-class (eieio--object-class this))
+ (slots (eieio--class-slots this-class)))
+ (dotimes (i (length slots))
;; For each slot, see if we need to evaluate it.
;;
;; Paul Landes said in an email:
;; > the quoted thing as you already have. This is by the
;; > Sonya E. Keene book and other things I've look at on the
;; > web.
- (let ((dflt (eieio-default-eval-maybe (car defaults))))
- (when (not (eq dflt (car defaults)))
- (eieio-oset this (car slot) dflt) ))
- ;; Next.
- (setq slot (cdr slot)
- defaults (cdr defaults))))
+ (let* ((slot (aref slots i))
+ (initform (cl--slot-descriptor-initform slot))
+ (dflt (eieio-default-eval-maybe initform)))
+ (when (not (eq dflt initform))
+ ;; FIXME: We should be able to just do (aset this (+ i <cst>) dflt)!
+ (eieio-oset this (cl--slot-descriptor-name slot) dflt)))))
;; Shared initialize will parse our slots for us.
(shared-initialize this slots))
In CLOS, the argument list is (CLASS OBJECT SLOT-NAME), but
EIEIO can only dispatch on the first argument, so the first two are swapped."
- (signal 'unbound-slot (list (eieio-class-name class) (eieio-object-name object)
+ (signal 'unbound-slot (list (eieio-class-name class)
+ (eieio-object-name object)
slot-name fn)))
(cl-defgeneric clone (obj &rest params)
(prin1 (eieio-object-name-string this))
(princ "\n")
;; Loop over all the public slots
- (let ((publa (eieio--class-public-a cv))
- (publd (eieio--class-public-d cv))
- (publp (eieio--class-public-printer cv))
+ (let ((slots (eieio--class-slots cv))
(eieio-print-depth (1+ eieio-print-depth)))
- (while publa
- (when (slot-boundp this (car publa))
- (let ((i (eieio--class-slot-initarg cv (car publa)))
- (v (eieio-oref this (car publa)))
- )
- (unless (or (not i) (equal v (car publd)))
- (unless (bolp)
- (princ "\n"))
- (princ (make-string (* eieio-print-depth 2) ? ))
- (princ (symbol-name i))
- (if (car publp)
- ;; Use our public printer
- (progn
- (princ " ")
- (funcall (car publp) v))
- ;; Use our generic override prin1 function.
- (princ (if (or (eieio-object-p v)
- (eieio-object-p (car-safe v)))
- "\n" " "))
- (eieio-override-prin1 v)))))
- (setq publa (cdr publa) publd (cdr publd)
- publp (cdr publp))))
+ (dotimes (i (length slots))
+ (let ((slot (aref slots i)))
+ (when (slot-boundp this (cl--slot-descriptor-name slot))
+ (let ((i (eieio--class-slot-initarg
+ cv (cl--slot-descriptor-name slot)))
+ (v (eieio-oref this (cl--slot-descriptor-name slot))))
+ (unless (or (not i) (equal v (cl--slot-descriptor-initform slot)))
+ (unless (bolp)
+ (princ "\n"))
+ (princ (make-string (* eieio-print-depth 2) ? ))
+ (princ (symbol-name i))
+ (if (alist-get :printer (cl--slot-descriptor-props slot))
+ ;; Use our public printer
+ (progn
+ (princ " ")
+ (funcall (alist-get :printer
+ (cl--slot-descriptor-props slot))
+ v))
+ ;; Use our generic override prin1 function.
+ (princ (if (or (eieio-object-p v)
+ (eieio-object-p (car-safe v)))
+ "\n" " "))
+ (eieio-override-prin1 v))))))))
(princ ")")
(when (= eieio-print-depth 0)
(princ "\n"))))
((consp thing)
(eieio-list-prin1 thing))
((eieio--class-p thing)
- (princ (eieio-class-name thing)))
+ (princ (eieio--class-print-name thing)))
(t (prin1 thing))))
(defun eieio-list-prin1 (list)
Used as advice around `edebug-prin1-to-string', held in the
variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to
`prin1-to-string' when appropriate."
- (cond ((eieio--class-p object) (eieio-class-name object))
+ (cond ((eieio--class-p object) (eieio--class-print-name object))
((eieio-object-p object) (object-print object))
((and (listp object) (or (eieio--class-p (car object))
(eieio-object-p (car object))))
\f
;;; Start of automatically extracted autoloads.
\f
-;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "2ec91e473fcad1ff20cd76edc4aab706")
+;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "813d32fbf76d4248fc6b4dc97ebcd720")
;;; Generated autoloads from eieio-custom.el
(autoload 'customize-object "eieio-custom" "\
;;;***
\f
-;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "ff1097f185bc2c253276a7d19fe2f54a")
+;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "3005b815c6b30eccbf0642170b3f82a5")
;;; Generated autoloads from eieio-opt.el
(autoload 'eieio-browse "eieio-opt" "\
--- /dev/null
+;;; generator.el --- generators -*- lexical-binding: t -*-
+
+;;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Daniel Colascione <dancol@dancol.org>
+;; Keywords: extensions, elisp
+;; 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 package implements generators for Emacs Lisp through a
+;; continuation-passing transformation. It provides essentially the
+;; same generator API and iterator facilities that Python and
+;; JavaScript ES6 provide.
+;;
+;; `iter-lambda' and `iter-defun' work like `lambda' and `defun',
+;; except that they evaluate to or define, respectively, generator
+;; functions. These functions, when called, return an iterator.
+;; An iterator is an opaque object that generates a sequence of
+;; values. Callers use `iter-next' to retrieve the next value from
+;; the sequence; when the sequence is exhausted, `iter-next' will
+;; raise the `iter-end-of-sequence' condition.
+;;
+;; Generator functions are written like normal functions, except that
+;; they can invoke `iter-yield' to suspend themselves and return a
+;; value to callers; this value becomes the return value of
+;; `iter-next'. On the next call to `iter-next', execution of the
+;; generator function resumes where it left off. When a generator
+;; function returns normally, the `iter-next' raises
+;; `iter-end-of-sequence' with the value the function returned.
+;;
+;; `iter-yield-from' yields all the values from another iterator; it
+;; then evaluates to the value the sub-iterator returned normally.
+;; This facility is useful for functional composition of generators
+;; and for implementing coroutines.
+;;
+;; `iter-yield' is illegal inside the UNWINDFORMS of an
+;; `unwind-protect' for various sordid internal reasons documented in
+;; the code.
+;;
+;; N.B. Each call to a generator function generates a *new* iterator,
+;; and each iterator maintains its own internal state.
+;;
+;; This raw form of iteration is general, but a bit awkward to use, so
+;; this library also provides some convenience functions:
+;;
+;; `iter-do' is like `cl-do', except that instead of walking a list,
+;; it walks an iterator. `cl-loop' is also extended with a new
+;; keyword, `iter-by', that iterates over an iterator.
+;;
+
+;;; Implementation:
+
+;;
+;; The internal cps transformation code uses the cps- namespace.
+;; Iteration functions use the `iter-' namespace. Generator functions
+;; are somewhat less efficient than conventional elisp routines,
+;; although we try to avoid CPS transformation on forms that do not
+;; invoke `iter-yield'.
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'pcase)
+
+(defvar cps--bindings nil)
+(defvar cps--states nil)
+(defvar cps--value-symbol nil)
+(defvar cps--state-symbol nil)
+(defvar cps--cleanup-table-symbol nil)
+(defvar cps--cleanup-function nil)
+
+(defmacro cps--gensym (fmt &rest args)
+ ;; Change this function to use `cl-gensym' if you want the generated
+ ;; code to be easier to read and debug.
+ ;; (cl-gensym (apply #'format fmt args))
+ `(make-symbol ,fmt))
+
+(defvar cps--dynamic-wrappers '(identity)
+ "List of transformer functions to apply to atomic forms we
+evaluate in CPS context.")
+
+(defconst cps-standard-special-forms
+ '(setq setq-default throw interactive)
+ "List of special forms that we treat just like ordinary
+ function applications." )
+
+(defun cps--trace-funcall (func &rest args)
+ (message "%S: args=%S" func args)
+ (let ((result (apply func args)))
+ (message "%S: result=%S" func result)
+ result))
+
+(defun cps--trace (fmt &rest args)
+ (princ (apply #'format (concat fmt "\n") args)))
+
+(defun cps--special-form-p (definition)
+ "Non-nil if and only if DEFINITION is a special form."
+ ;; Copied from ad-special-form-p
+ (if (and (symbolp definition) (fboundp definition))
+ (setf definition (indirect-function definition)))
+ (and (subrp definition) (eq (cdr (subr-arity definition)) 'unevalled)))
+
+(defmacro cps--define-unsupported (function)
+ `(defun ,(intern (format "cps--transform-%s" function))
+ (error "%s not supported in generators" ,function)))
+
+(defmacro cps--with-value-wrapper (wrapper &rest body)
+ "Continue generating CPS code with an atomic-form wrapper
+to the current stack of such wrappers. WRAPPER is a function that
+takes a form and returns a wrapped form.
+
+Whenever we generate an atomic form (i.e., a form that can't
+iter-yield), we first (before actually inserting that form in our
+generated code) pass that form through all the transformer
+functions. We use this facility to wrap forms that can transfer
+control flow non-locally in goo that diverts this control flow to
+the CPS state machinery.
+"
+ (declare (indent 1))
+ `(let ((cps--dynamic-wrappers
+ (cons
+ ,wrapper
+ cps--dynamic-wrappers)))
+ ,@body))
+
+(defun cps--make-dynamic-binding-wrapper (dynamic-var static-var)
+ (cl-assert lexical-binding)
+ (lambda (form)
+ `(let ((,dynamic-var ,static-var))
+ (unwind-protect ; Update the static shadow after evaluation is done
+ ,form
+ (setf ,static-var ,dynamic-var))
+ ,form)))
+
+(defmacro cps--with-dynamic-binding (dynamic-var static-var &rest body)
+ "Evaluate BODY such that generated atomic evaluations run with
+DYNAMIC-VAR bound to STATIC-VAR."
+ (declare (indent 2))
+ `(cps--with-value-wrapper
+ (cps--make-dynamic-binding-wrapper ,dynamic-var ,static-var)
+ ,@body))
+
+(defun cps--add-state (kind body)
+ "Create a new CPS state with body BODY and return the state's name."
+ (declare (indent 1))
+ (let* ((state (cps--gensym "cps-state-%s-" kind)))
+ (push (list state body cps--cleanup-function) cps--states)
+ (push state cps--bindings)
+ state))
+
+(defun cps--add-binding (original-name)
+ (car (push (cps--gensym (format "cps-binding-%s-" original-name))
+ cps--bindings)))
+
+(defun cps--find-special-form-handler (form)
+ (let* ((handler-name (format "cps--transform-%s" (car-safe form)))
+ (handler (intern-soft handler-name)))
+ (and (fboundp handler) handler)))
+
+(defvar cps-inhibit-atomic-optimization nil
+ "When t, always rewrite forms into cps even when they
+don't yield.")
+
+(defvar cps--yield-seen)
+
+(defun cps--atomic-p (form)
+ "Return whether the given form never yields."
+
+ (and (not cps-inhibit-atomic-optimization)
+ (let* ((cps--yield-seen))
+ (ignore (macroexpand-all
+ `(cl-macrolet ((cps-internal-yield
+ (_val)
+ (setf cps--yield-seen t)))
+ ,form)
+ macroexpand-all-environment))
+ (not cps--yield-seen))))
+
+(defun cps--make-atomic-state (form next-state)
+ (let ((tform `(prog1 ,form (setf ,cps--state-symbol ,next-state))))
+ (cl-loop for wrapper in cps--dynamic-wrappers
+ do (setf tform (funcall wrapper tform)))
+ ;; Bind cps--cleanup-function to nil here because the wrapper
+ ;; function mechanism is responsible for cleanup here, not the
+ ;; generic cleanup mechanism. If we didn't make this binding,
+ ;; we'd run cleanup handlers twice on anything that made it out
+ ;; to toplevel.
+ (let ((cps--cleanup-function nil))
+ (cps--add-state "atom"
+ `(setf ,cps--value-symbol ,tform)))))
+
+(defun cps--transform-1 (form next-state)
+ (pcase form
+
+ ;; If we're looking at an "atomic" form (i.e., one that does not
+ ;; iter-yield), just evaluate the form as a whole instead of rewriting
+ ;; it into CPS.
+
+ ((guard (cps--atomic-p form))
+ (cps--make-atomic-state form next-state))
+
+ ;; Process `and'.
+
+ (`(and) ; (and) -> t
+ (cps--transform-1 t next-state))
+ (`(and ,condition) ; (and CONDITION) -> CONDITION
+ (cps--transform-1 condition next-state))
+ (`(and ,condition . ,rest)
+ ;; Evaluate CONDITION; if it's true, go on to evaluate the rest
+ ;; of the `and'.
+ (cps--transform-1
+ condition
+ (cps--add-state "and"
+ `(setf ,cps--state-symbol
+ (if ,cps--value-symbol
+ ,(cps--transform-1 `(and ,@rest)
+ next-state)
+ ,next-state)))))
+
+ ;; Process `catch'.
+
+ (`(catch ,tag . ,body)
+ (let ((tag-binding (cps--add-binding "catch-tag")))
+ (cps--transform-1 tag
+ (cps--add-state "cps-update-tag"
+ `(setf ,tag-binding ,cps--value-symbol
+ ,cps--state-symbol
+ ,(cps--with-value-wrapper
+ (cps--make-catch-wrapper
+ tag-binding next-state)
+ (cps--transform-1 `(progn ,@body)
+ next-state)))))))
+
+ ;; Process `cond': transform into `if' or `or' depending on the
+ ;; precise kind of the condition we're looking at.
+
+ (`(cond) ; (cond) -> nil
+ (cps--transform-1 nil next-state))
+ (`(cond (,condition) . ,rest)
+ (cps--transform-1 `(or ,condition (cond ,@rest))
+ next-state))
+ (`(cond (,condition . ,body) . ,rest)
+ (cps--transform-1 `(if ,condition
+ (progn ,@body)
+ (cond ,@rest))
+ next-state))
+
+ ;; Process `condition-case': do the heavy lifting in a helper
+ ;; function.
+
+ (`(condition-case ,var ,bodyform . ,handlers)
+ (cps--with-value-wrapper
+ (cps--make-condition-wrapper var next-state handlers)
+ (cps--transform-1 bodyform
+ next-state)))
+
+ ;; Process `if'.
+
+ (`(if ,cond ,then . ,else)
+ (cps--transform-1 cond
+ (cps--add-state "if"
+ `(setf ,cps--state-symbol
+ (if ,cps--value-symbol
+ ,(cps--transform-1 then
+ next-state)
+ ,(cps--transform-1 `(progn ,@else)
+ next-state))))))
+
+ ;; Process `progn' and `inline': they are identical except for the
+ ;; name, which has some significance to the byte compiler.
+
+ (`(inline) (cps--transform-1 nil next-state))
+ (`(inline ,form) (cps--transform-1 form next-state))
+ (`(inline ,form . ,rest)
+ (cps--transform-1 form
+ (cps--transform-1 `(inline ,@rest)
+ next-state)))
+
+ (`(progn) (cps--transform-1 nil next-state))
+ (`(progn ,form) (cps--transform-1 form next-state))
+ (`(progn ,form . ,rest)
+ (cps--transform-1 form
+ (cps--transform-1 `(progn ,@rest)
+ next-state)))
+
+ ;; Process `let' in a helper function that transforms it into a
+ ;; let* with temporaries.
+
+ (`(let ,bindings . ,body)
+ (let* ((bindings (cl-loop for binding in bindings
+ collect (if (symbolp binding)
+ (list binding nil)
+ binding)))
+ (temps (cl-loop for (var value-form) in bindings
+ collect (cps--add-binding var))))
+ (cps--transform-1
+ `(let* ,(append
+ (cl-loop for (var value-form) in bindings
+ for temp in temps
+ collect (list temp value-form))
+ (cl-loop for (var binding) in bindings
+ for temp in temps
+ collect (list var temp)))
+ ,@body)
+ next-state)))
+
+ ;; Process `let*' binding: process one binding at a time. Flatten
+ ;; lexical bindings.
+
+ (`(let* () . ,body)
+ (cps--transform-1 `(progn ,@body) next-state))
+
+ (`(let* (,binding . ,more-bindings) . ,body)
+ (let* ((var (if (symbolp binding) binding (car binding)))
+ (value-form (car (cdr-safe binding)))
+ (new-var (cps--add-binding var)))
+
+ (cps--transform-1
+ value-form
+ (cps--add-state "let*"
+ `(setf ,new-var ,cps--value-symbol
+ ,cps--state-symbol
+ ,(if (or (not lexical-binding) (special-variable-p var))
+ (cps--with-dynamic-binding var new-var
+ (cps--transform-1
+ `(let* ,more-bindings ,@body)
+ next-state))
+ (cps--transform-1
+ (cps--replace-variable-references
+ var new-var
+ `(let* ,more-bindings ,@body))
+ next-state)))))))
+
+ ;; Process `or'.
+
+ (`(or) (cps--transform-1 nil next-state))
+ (`(or ,condition) (cps--transform-1 condition next-state))
+ (`(or ,condition . ,rest)
+ (cps--transform-1
+ condition
+ (cps--add-state "or"
+ `(setf ,cps--state-symbol
+ (if ,cps--value-symbol
+ ,next-state
+ ,(cps--transform-1
+ `(or ,@rest) next-state))))))
+
+ ;; Process `prog1'.
+
+ (`(prog1 ,first) (cps--transform-1 first next-state))
+ (`(prog1 ,first . ,body)
+ (cps--transform-1
+ first
+ (let ((temp-var-symbol (cps--add-binding "prog1-temp")))
+ (cps--add-state "prog1"
+ `(setf ,temp-var-symbol
+ ,cps--value-symbol
+ ,cps--state-symbol
+ ,(cps--transform-1
+ `(progn ,@body)
+ (cps--add-state "prog1inner"
+ `(setf ,cps--value-symbol ,temp-var-symbol
+ ,cps--state-symbol ,next-state))))))))
+
+ ;; Process `prog2'.
+
+ (`(prog2 ,form1 ,form2 . ,body)
+ (cps--transform-1
+ `(progn ,form1 (prog1 ,form2 ,@body))
+ next-state))
+
+ ;; Process `unwind-protect': If we're inside an unwind-protect, we
+ ;; have a block of code UNWINDFORMS which we would like to run
+ ;; whenever control flows away from the main piece of code,
+ ;; BODYFORM. We deal with the local control flow case by
+ ;; generating BODYFORM such that it yields to a continuation that
+ ;; executes UNWINDFORMS, which then yields to NEXT-STATE.
+ ;;
+ ;; Non-local control flow is trickier: we need to ensure that we
+ ;; execute UNWINDFORMS even when control bypasses our normal
+ ;; continuation. To make this guarantee, we wrap every external
+ ;; application (i.e., every piece of elisp that can transfer
+ ;; control non-locally) in an unwind-protect that runs UNWINDFORMS
+ ;; before allowing the non-local control transfer to proceed.
+ ;;
+ ;; Unfortunately, because elisp lacks a mechanism for generically
+ ;; capturing the reason for an arbitrary non-local control
+ ;; transfer and restarting the transfer at a later point, we
+ ;; cannot reify non-local transfers and cannot allow
+ ;; continuation-passing code inside UNWINDFORMS.
+
+ (`(unwind-protect ,bodyform . ,unwindforms)
+ ;; Signal the evaluator-generator that it needs to generate code
+ ;; to handle cleanup forms.
+ (unless cps--cleanup-table-symbol
+ (setf cps--cleanup-table-symbol (cps--gensym "cps-cleanup-table-")))
+ (let* ((unwind-state
+ (cps--add-state
+ "unwind"
+ ;; N.B. It's safe to just substitute unwindforms by
+ ;; sexp-splicing: we've already replaced all variable
+ ;; references inside it with lifted equivalents.
+ `(progn
+ ,@unwindforms
+ (setf ,cps--state-symbol ,next-state))))
+ (old-cleanup cps--cleanup-function)
+ (cps--cleanup-function
+ (let ((cps--cleanup-function nil))
+ (cps--add-state "cleanup"
+ `(progn
+ ,(when old-cleanup `(funcall ,old-cleanup))
+ ,@unwindforms)))))
+ (cps--with-value-wrapper
+ (cps--make-unwind-wrapper unwindforms)
+ (cps--transform-1 bodyform unwind-state))))
+
+ ;; Process `while'.
+
+ (`(while ,test . ,body)
+ ;; Open-code state addition instead of using cps--add-state: we
+ ;; need our states to be self-referential. (That's what makes the
+ ;; state a loop.)
+ (let* ((loop-state
+ (cps--gensym "cps-state-while-"))
+ (eval-loop-condition-state
+ (cps--transform-1 test loop-state))
+ (loop-state-body
+ `(progn
+ (setf ,cps--state-symbol
+ (if ,cps--value-symbol
+ ,(cps--transform-1
+ `(progn ,@body)
+ eval-loop-condition-state)
+ ,next-state)))))
+ (push (list loop-state loop-state-body cps--cleanup-function)
+ cps--states)
+ (push loop-state cps--bindings)
+ eval-loop-condition-state))
+
+ ;; Process various kinds of `quote'.
+
+ (`(quote ,arg) (cps--add-state "quote"
+ `(setf ,cps--value-symbol (quote ,arg)
+ ,cps--state-symbol ,next-state)))
+ (`(function ,arg) (cps--add-state "function"
+ `(setf ,cps--value-symbol (function ,arg)
+ ,cps--state-symbol ,next-state)))
+
+ ;; Deal with `iter-yield'.
+
+ (`(cps-internal-yield ,value)
+ (cps--transform-1
+ value
+ (cps--add-state "iter-yield"
+ `(progn
+ (setf ,cps--state-symbol
+ ,(if cps--cleanup-function
+ (cps--add-state "after-yield"
+ `(setf ,cps--state-symbol ,next-state))
+ next-state))
+ (throw 'cps--yield ,cps--value-symbol)))))
+
+ ;; Catch any unhandled special forms.
+
+ ((and `(,name . ,_)
+ (guard (cps--special-form-p name))
+ (guard (not (memq name cps-standard-special-forms))))
+ name ; Shut up byte compiler
+ (error "special form %S incorrect or not supported" form))
+
+ ;; Process regular function applications with nontrivial
+ ;; parameters, converting them to applications of trivial
+ ;; let-bound parameters.
+
+ ((and `(,function . ,arguments)
+ (guard (not (cl-loop for argument in arguments
+ always (atom argument)))))
+ (let ((argument-symbols
+ (cl-loop for argument in arguments
+ collect (if (atom argument)
+ argument
+ (cps--gensym "cps-argument-")))))
+
+ (cps--transform-1
+ `(let* ,(cl-loop for argument in arguments
+ for argument-symbol in argument-symbols
+ unless (eq argument argument-symbol)
+ collect (list argument-symbol argument))
+ ,(cons function argument-symbols))
+ next-state)))
+
+ ;; Process everything else by just evaluating the form normally.
+ (t (cps--make-atomic-state form next-state))))
+
+(defun cps--make-catch-wrapper (tag-binding next-state)
+ (lambda (form)
+ (let ((normal-exit-symbol
+ (cps--gensym "cps-normal-exit-from-catch-")))
+ `(let (,normal-exit-symbol)
+ (prog1
+ (catch ,tag-binding
+ (prog1
+ ,form
+ (setf ,normal-exit-symbol t)))
+ (unless ,normal-exit-symbol
+ (setf ,cps--state-symbol ,next-state)))))))
+
+(defun cps--make-condition-wrapper (var next-state handlers)
+ ;; Each handler is both one of the transformers with which we wrap
+ ;; evaluated atomic forms and a state to which we jump when we
+ ;; encounter the given error.
+
+ (let* ((error-symbol (cps--add-binding "condition-case-error"))
+ (lexical-error-symbol (cps--gensym "cps-lexical-error-"))
+ (processed-handlers
+ (cl-loop for (condition . body) in handlers
+ collect (cons condition
+ (cps--transform-1
+ (cps--replace-variable-references
+ var error-symbol
+ `(progn ,@body))
+ next-state)))))
+
+ (lambda (form)
+ `(condition-case
+ ,lexical-error-symbol
+ ,form
+ ,@(cl-loop
+ for (condition . error-state) in processed-handlers
+ collect
+ `(,condition
+ (setf ,error-symbol
+ ,lexical-error-symbol
+ ,cps--state-symbol
+ ,error-state)))))))
+
+(defun cps--replace-variable-references (var new-var form)
+ "Replace all non-shadowed references to VAR with NEW-VAR in FORM.
+This routine does not modify FORM. Instead, it returns a
+modified copy."
+ (macroexpand-all
+ `(cl-symbol-macrolet ((,var ,new-var)) ,form)
+ macroexpand-all-environment))
+
+(defun cps--make-unwind-wrapper (unwind-forms)
+ (cl-assert lexical-binding)
+ (lambda (form)
+ (let ((normal-exit-symbol
+ (cps--gensym "cps-normal-exit-from-unwind-")))
+ `(let (,normal-exit-symbol)
+ (unwind-protect
+ (prog1
+ ,form
+ (setf ,normal-exit-symbol t))
+ (unless ,normal-exit-symbol
+ ,@unwind-forms))))))
+
+(put 'iter-end-of-sequence 'error-conditions '(iter-end-of-sequence))
+(put 'iter-end-of-sequence 'error-message "iteration terminated")
+
+(defun cps--make-close-iterator-form (terminal-state)
+ (if cps--cleanup-table-symbol
+ `(let ((cleanup (cdr (assq ,cps--state-symbol ,cps--cleanup-table-symbol))))
+ (setf ,cps--state-symbol ,terminal-state
+ ,cps--value-symbol nil)
+ (when cleanup (funcall cleanup)))
+ `(setf ,cps--state-symbol ,terminal-state
+ ,cps--value-symbol nil)))
+
+(defun cps-generate-evaluator (body)
+ (let* (cps--states
+ cps--bindings
+ cps--cleanup-function
+ (cps--value-symbol (cps--gensym "cps-current-value-"))
+ (cps--state-symbol (cps--gensym "cps-current-state-"))
+ ;; We make *cps-cleanup-table-symbol** non-nil when we notice
+ ;; that we have cleanup processing to perform.
+ (cps--cleanup-table-symbol nil)
+ (terminal-state (cps--add-state "terminal"
+ `(signal 'iter-end-of-sequence
+ ,cps--value-symbol)))
+ (initial-state (cps--transform-1
+ (macroexpand-all
+ `(cl-macrolet
+ ((iter-yield (value)
+ `(cps-internal-yield ,value)))
+ ,@body)
+ macroexpand-all-environment)
+ terminal-state))
+ (finalizer-symbol
+ (when cps--cleanup-table-symbol
+ (when cps--cleanup-table-symbol
+ (cps--gensym "cps-iterator-finalizer-")))))
+ `(let ,(append (list cps--state-symbol cps--value-symbol)
+ (when cps--cleanup-table-symbol
+ (list cps--cleanup-table-symbol))
+ (when finalizer-symbol
+ (list finalizer-symbol))
+ (nreverse cps--bindings))
+ ;; Order state list so that cleanup states are always defined
+ ;; before they're referenced.
+ ,@(cl-loop for (state body cleanup) in (nreverse cps--states)
+ collect `(setf ,state (lambda () ,body))
+ when cleanup
+ do (cl-assert cps--cleanup-table-symbol)
+ and collect `(push (cons ,state ,cleanup) ,cps--cleanup-table-symbol))
+ (setf ,cps--state-symbol ,initial-state)
+
+ (let ((iterator
+ (lambda (op value)
+ (cond
+ ,@(when finalizer-symbol
+ `(((eq op :stash-finalizer)
+ (setf ,finalizer-symbol value))
+ ((eq op :get-finalizer)
+ ,finalizer-symbol)))
+ ((eq op :close)
+ ,(cps--make-close-iterator-form terminal-state))
+ ((eq op :next)
+ (setf ,cps--value-symbol value)
+ (let ((yielded nil))
+ (unwind-protect
+ (prog1
+ (catch 'cps--yield
+ (while t
+ (funcall ,cps--state-symbol)))
+ (setf yielded t))
+ (unless yielded
+ ;; If we're exiting non-locally (error, quit,
+ ;; etc.) close the iterator.
+ ,(cps--make-close-iterator-form terminal-state)))))
+ (t (error "unknown iterator operation %S" op))))))
+ ,(when finalizer-symbol
+ `(funcall iterator
+ :stash-finalizer
+ (make-finalizer
+ (lambda ()
+ (iter-close iterator)))))
+ iterator))))
+
+(defun iter-yield (value)
+ "When used inside a generator, yield control to caller.
+The caller of `iter-next' receives VALUE, and the next call to
+`iter-next' resumes execution at the previous
+`iter-yield' point."
+ (identity value)
+ (error "`iter-yield' used outside a generator"))
+
+(defmacro iter-yield-from (value)
+ "When used inside a generator function, delegate to a sub-iterator.
+The values that the sub-iterator yields are passed directly to
+the caller, and values supplied to `iter-next' are sent to the
+sub-iterator. `iter-yield-from' evaluates to the value that the
+sub-iterator function returns via `iter-end-of-sequence'."
+ (let ((errsym (cps--gensym "yield-from-result"))
+ (valsym (cps--gensym "yield-from-value")))
+ `(let ((,valsym ,value))
+ (unwind-protect
+ (condition-case ,errsym
+ (let ((vs nil))
+ (while t
+ (setf vs (iter-yield (iter-next ,valsym vs)))))
+ (iter-end-of-sequence (cdr ,errsym)))
+ (iter-close ,valsym)))))
+
+(defmacro iter-defun (name arglist &rest body)
+ "Creates a generator NAME.
+When called as a function, NAME returns an iterator value that
+encapsulates the state of a computation that produces a sequence
+of values. Callers can retrieve each value using `iter-next'."
+ (declare (indent defun))
+ (cl-assert lexical-binding)
+ (let* ((parsed-body (macroexp-parse-body body))
+ (declarations (car parsed-body))
+ (exps (cdr parsed-body)))
+ `(defun ,name ,arglist
+ ,@declarations
+ ,(cps-generate-evaluator exps))))
+
+(defmacro iter-lambda (arglist &rest body)
+ "Return a lambda generator.
+`iter-lambda' is to `iter-defun' as `lambda' is to `defun'."
+ (declare (indent defun))
+ (cl-assert lexical-binding)
+ `(lambda ,arglist
+ ,(cps-generate-evaluator body)))
+
+(defun iter-next (iterator &optional yield-result)
+ "Extract a value from an iterator.
+YIELD-RESULT becomes the return value of `iter-yield` in the
+context of the generator.
+
+This routine raises the `iter-end-of-sequence' condition if the
+iterator cannot supply more values."
+ (funcall iterator :next yield-result))
+
+(defun iter-close (iterator)
+ "Terminate an iterator early.
+Run any unwind-protect handlers in scope at the point ITERATOR
+is blocked."
+ (funcall iterator :close nil))
+
+(cl-defmacro iter-do ((var iterator) &rest body)
+ "Loop over values from an iterator.
+Evaluate BODY with VAR bound to each value from ITERATOR.
+Return the value with which ITERATOR finished iteration."
+ (declare (indent 1))
+ (let ((done-symbol (cps--gensym "iter-do-iterator-done"))
+ (condition-symbol (cps--gensym "iter-do-condition"))
+ (it-symbol (cps--gensym "iter-do-iterator"))
+ (result-symbol (cps--gensym "iter-do-result")))
+ `(let (,var
+ ,result-symbol
+ (,done-symbol nil)
+ (,it-symbol ,iterator))
+ (while (not ,done-symbol)
+ (condition-case ,condition-symbol
+ (setf ,var (iter-next ,it-symbol))
+ (iter-end-of-sequence
+ (setf ,result-symbol (cdr ,condition-symbol))
+ (setf ,done-symbol t)))
+ (unless ,done-symbol ,@body))
+ ,result-symbol)))
+
+(defvar cl--loop-args)
+
+(defmacro cps--advance-for (conscell)
+ ;; See cps--handle-loop-for
+ `(condition-case nil
+ (progn
+ (setcar ,conscell (iter-next (cdr ,conscell)))
+ ,conscell)
+ (iter-end-of-sequence
+ nil)))
+
+(defmacro cps--initialize-for (iterator)
+ ;; See cps--handle-loop-for
+ (let ((cs (cps--gensym "cps--loop-temp")))
+ `(let ((,cs (cons nil ,iterator)))
+ (cps--advance-for ,cs))))
+
+(defun cps--handle-loop-for (var)
+ "Support `iter-by' in `loop'. "
+ ;; N.B. While the cl-loop-for-handler is a documented interface,
+ ;; there's no documented way for cl-loop-for-handler callbacks to do
+ ;; anything useful! Additionally, cl-loop currently lexbinds useful
+ ;; internal variables, so our only option is to modify
+ ;; cl--loop-args. If we substitute a general-purpose for-clause for
+ ;; our iterating clause, however, we can't preserve the
+ ;; parallel-versus-sequential `loop' semantics for for clauses ---
+ ;; we need a terminating condition as well, which requires us to use
+ ;; while, and inserting a while would break and-sequencing.
+ ;;
+ ;; To work around this problem, we actually use the "for var in LIST
+ ;; by FUNCTION" syntax, creating a new fake list each time through
+ ;; the loop, this "list" being a cons cell (val . it).
+ (let ((it-form (pop cl--loop-args)))
+ (setf cl--loop-args
+ (append
+ `(for ,var
+ in (cps--initialize-for ,it-form)
+ by 'cps--advance-for)
+ cl--loop-args))))
+
+(put 'iter-by 'cl-loop-for-handler 'cps--handle-loop-for)
+
+(eval-after-load 'elisp-mode
+ (lambda ()
+ (font-lock-add-keywords
+ 'emacs-lisp-mode
+ '(("(\\(iter-defun\\)\\_>\\s *\\(\\(?:\\sw\\|\\s_\\)+\\)?"
+ (1 font-lock-keyword-face nil t)
+ (2 font-lock-function-name-face nil t))
+ ("(\\(iter-\\(?:next\\|lambda\\|yield\\|yield-from\\)\\)\\_>"
+ (1 font-lock-keyword-face nil t))))))
+
+(provide 'generator)
+
+;;; generator.el ends here
Note: this only works reliably with lexical binding mode, except for very
simple PLACEs such as (function-symbol 'foo) which will also work in dynamic
binding mode."
- (gv-letplace (getter setter) place
- `(cons (lambda () ,getter)
- (lambda (gv--val) ,(funcall setter 'gv--val)))))
+ (let ((code
+ (gv-letplace (getter setter) place
+ `(cons (lambda () ,getter)
+ (lambda (gv--val) ,(funcall setter 'gv--val))))))
+ (if (or lexical-binding
+ ;; If `code' still starts with `cons' then presumably gv-letplace
+ ;; did not add any new let-bindings, so the `lambda's don't capture
+ ;; any new variables. As a consequence, the code probably works in
+ ;; dynamic binding mode as well.
+ (eq (car-safe code) 'cons))
+ code
+ (macroexp--warn-and-return
+ "Use of gv-ref probably requires lexical-binding"
+ code))))
(defsubst gv-deref (ref)
"Dereference REF, returning the referenced value.
;; Look for an SCCS header
((re-search-forward
(concat
- (regexp-quote "@(#)")
- (regexp-quote (file-name-nondirectory (buffer-file-name)))
+ "@(#)"
+ (if buffer-file-name
+ (regexp-quote (file-name-nondirectory buffer-file-name))
+ "[^\t\n]*")
"\t\\([012345679.]*\\)")
header-max t)
(match-string-no-properties 1)))))))
nil)))
res))
+(defun lisp--el-non-funcall-position-p (&optional pos)
+ "Heuristically determine whether POS is an evaluated position."
+ (setf pos (or pos (point)))
+ (save-match-data
+ (save-excursion
+ (ignore-errors
+ (goto-char pos)
+ (or (eql (char-before) ?\')
+ (let ((parent
+ (progn
+ (up-list -1)
+ (cond
+ ((ignore-errors
+ (and (eql (char-after) ?\()
+ (progn
+ (up-list -1)
+ (looking-at "(\\_<let\\*?\\_>"))))
+ (goto-char (match-end 0))
+ 'let)
+ ((looking-at
+ (rx "("
+ (group-n 1 (+ (or (syntax w) (syntax _))))
+ symbol-end))
+ (prog1 (intern-soft (match-string-no-properties 1))
+ (goto-char (match-end 1))))))))
+ (or (eq parent 'declare)
+ (and (eq parent 'let)
+ (progn
+ (forward-sexp 1)
+ (< pos (point))))
+ (and (eq parent 'condition-case)
+ (progn
+ (forward-sexp 2)
+ (< (point) pos))))))))))
+
+(defun lisp--el-match-keyword (limit)
+ (catch 'found
+ (while (re-search-forward "(\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>" limit t)
+ (let ((sym (intern-soft (match-string 1))))
+ (when (or (special-form-p sym)
+ (and (macrop sym)
+ (not (get sym 'no-font-lock-keyword))
+ (not (lisp--el-non-funcall-position-p
+ (match-beginning 0)))))
+ (throw 'found t))))))
+
+(defun lisp--el-font-lock-flush-elisp-buffers (&optional file)
+ ;; Don't flush during load unless called from after-load-functions.
+ ;; In that case, FILE is non-nil. It's somehow strange that
+ ;; load-in-progress is t when an after-load-function is called since
+ ;; that should run *after* the load...
+ (when (or (not load-in-progress) file)
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when (derived-mode-p 'emacs-lisp-mode)
+ (font-lock-flush))))))
+
(pcase-let
((`(,vdefs ,tdefs
,el-defs-re ,cl-defs-re
"when" "unless" "with-output-to-string"
"ignore-errors" "dotimes" "dolist" "declare"))
(lisp-errs '("warn" "error" "signal"))
- ;; Elisp constructs. FIXME: update dynamically from obarray.
+ ;; Elisp constructs. Now they are update dynamically
+ ;; from obarray but they are also used for setting up
+ ;; the keywords for Common Lisp.
(el-fdefs '("define-advice" "defadvice" "defalias"
"define-derived-mode" "define-minor-mode"
"define-generic-mode" "define-global-minor-mode"
"defface"))
(el-tdefs '("defgroup" "deftheme"))
(el-kw '("while-no-input" "letrec" "pcase" "pcase-exhaustive"
- "pcase-let" "pcase-let*" "save-restriction"
+ "pcase-lambda" "pcase-let" "pcase-let*" "save-restriction"
"save-excursion" "save-selected-window"
;; "eval-after-load" "eval-next-after-load"
"save-window-excursion" "save-current-buffer"
(eieio-tdefs '("defclass"))
(eieio-kw '("with-slots"))
;; Common-Lisp constructs supported by cl-lib.
- (cl-lib-fdefs '("defmacro" "defsubst" "defun"))
+ (cl-lib-fdefs '("defmacro" "defsubst" "defun" "defmethod"))
(cl-lib-tdefs '("defstruct" "deftype"))
(cl-lib-kw '("progv" "eval-when" "case" "ecase" "typecase"
"etypecase" "ccase" "ctypecase" "loop" "do" "do*"
`( ;; Definitions.
(,(concat "(" el-defs-re "\\_>"
;; Any whitespace and defined object.
- "[ \t'\(]*"
- "\\(\\(?:\\sw\\|\\s_\\)+\\)?")
+ "[ \t']*"
+ "\\(([ \t']*\\)?" ;; An opening paren.
+ "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
(1 font-lock-keyword-face)
- (2 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
- (cond ((eq type 'var) font-lock-variable-name-face)
- ((eq type 'type) font-lock-type-face)
- (t font-lock-function-name-face)))
- nil t))
+ (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
+ (cond ((eq type 'var) font-lock-variable-name-face)
+ ((eq type 'type) font-lock-type-face)
+ ;; If match-string 2 is non-nil, we encountered a
+ ;; form like (defalias (intern (concat s "-p"))),
+ ;; unless match-string 4 is also there. Then its a
+ ;; defmethod with (setf foo) as name.
+ ((or (not (match-string 2)) ;; Normal defun.
+ (and (match-string 2) ;; Setf method.
+ (match-string 4))) font-lock-function-name-face)))
+ nil t))
;; Emacs Lisp autoload cookies. Supports the slightly different
;; forms used by mh-e, calendar, etc.
("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend))
`( ;; Definitions.
(,(concat "(" cl-defs-re "\\_>"
;; Any whitespace and defined object.
- "[ \t'\(]*"
- "\\(setf[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
+ "[ \t']*"
+ "\\(([ \t']*\\)?" ;; An opening paren.
+ "\\(\\(setf\\)[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
(1 font-lock-keyword-face)
- (2 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
+ (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
(cond ((eq type 'var) font-lock-variable-name-face)
((eq type 'type) font-lock-type-face)
- (t font-lock-function-name-face)))
+ ((or (not (match-string 2)) ;; Normal defun.
+ (and (match-string 2) ;; Setf function.
+ (match-string 4))) font-lock-function-name-face)))
nil t)))
"Subdued level highlighting for Lisp modes.")
`( ;; Regexp negated char group.
("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)
;; Control structures. Common Lisp forms.
- (,(concat "(" el-kws-re "\\_>") . 1)
+ (lisp--el-match-keyword . 1)
;; Exit/Feature symbols as constants.
(,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>"
"[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
. lisp-font-lock-syntactic-face-function)))
(setq-local prettify-symbols-alist lisp--prettify-symbols-alist)
(when elisp
+ (add-hook 'after-load-functions #'lisp--el-font-lock-flush-elisp-buffers)
(setq-local electric-pair-text-pairs
(cons '(?\` . ?\') electric-pair-text-pairs)))
(setq-local electric-pair-skip-whitespace 'chomp)
(backward-up-list arg)
(kill-sexp)
(insert current-sexp))
- (error "Not at a sexp"))))
+ (user-error "Not at a sexp"))))
\f
(defvar beginning-of-defun-function nil
"If non-nil, function for `beginning-of-defun-raw' to call.
(condition-case data
;; Buffer can't have more than (point-max) sexps.
(scan-sexps (point-min) (point-max))
- (scan-error (goto-char (nth 2 data))
+ (scan-error (push-mark)
+ (goto-char (nth 2 data))
;; Could print (nth 1 data), which is either
;; "Containing expression ends prematurely" or
;; "Unbalanced parentheses", but those may not be so
;;; Handy functions to use in macros.
+(defun macroexp-parse-body (body)
+ "Parse a function BODY into (DECLARATIONS . EXPS)."
+ (let ((decls ()))
+ (while (and (cdr body)
+ (let ((e (car body)))
+ (or (stringp e)
+ (memq (car-safe e)
+ '(:documentation declare interactive cl-declare)))))
+ (push (pop body) decls))
+ (cons (nreverse decls) body)))
+
(defun macroexp-progn (exps)
"Return an expression equivalent to `(progn ,@EXPS)."
(if (cdr exps) `(progn ,@exps) (car exps)))
(defvar macroexp--pending-eager-loads nil
"Stack of files currently undergoing eager macro-expansion.")
+(defvar macroexp--debug-eager nil)
+
(defun internal-macroexpand-for-load (form full-p)
;; Called from the eager-macroexpansion in readevalloop.
(cond
(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) " => "))
+ (if macroexp--debug-eager
+ (debug 'eager-macroexp-cycle)
+ (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
(concat (symbol-name pkg-name) "-readme.txt")
package-archive-upload-base)))
- (set-buffer pkg-buffer)
+ (set-buffer (if (eq file-type 'tar) tar-data-buffer pkg-buffer))
(write-region (point-min) (point-max)
(expand-file-name
(format "%s-%s.%s" pkg-name pkg-version extension)
;;; Code:
+(eval-when-compile (require 'subr-x))
(eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'epg)) ;For setf accessors.
:group 'applications
:version "24.1")
+\f
+;;; Customization options
;;;###autoload
(defcustom package-enable-at-startup t
"Whether to activate installed packages when Emacs starts.
:group 'package
:version "24.1")
-(defvar Info-directory-list)
-(declare-function info-initialize "info" ())
-(declare-function url-http-file-exists-p "url-http" (url))
-(declare-function lm-header "lisp-mnt" (header))
-(declare-function lm-commentary "lisp-mnt" (&optional file))
-
(defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/"))
"An alist of archives from which to fetch.
The default value points to the GNU Emacs package repository.
:group 'package
:version "24.4")
-(defconst package-archive-version 1
- "Version number of the package archive understood by this file.
-Lower version numbers than this will probably be understood as well.")
-
-;; We don't prime the cache since it tends to get out of date.
-(defvar package-archive-contents nil
- "Cache of the contents of the Emacs Lisp Package Archive.
-This is an alist mapping package names (symbols) to
-non-empty lists of `package-desc' structures.")
-(put 'package-archive-contents 'risky-local-variable t)
-
(defcustom package-user-dir (locate-user-emacs-file "elpa")
"Directory containing the user's Emacs Lisp packages.
The directory name should be absolute.
(let (result)
(dolist (f load-path)
(and (stringp f)
- (equal (file-name-nondirectory f) "site-lisp")
- (push (expand-file-name "elpa" f) result)))
+ (equal (file-name-nondirectory f) "site-lisp")
+ (push (expand-file-name "elpa" f) result)))
(nreverse result))
"List of additional directories containing Emacs Lisp packages.
Each directory name should be absolute.
This also applies to the \"archive-contents\" file that lists the
contents of the archive."
:type '(choice (const nil :tag "Never")
- (const allow-unsigned :tag "Allow unsigned")
- (const t :tag "Check always"))
+ (const allow-unsigned :tag "Allow unsigned")
+ (const t :tag "Check always"))
:risky t
:group 'package
:version "24.4")
:group 'package
:version "24.4")
+(defcustom package-selected-packages nil
+ "Store here packages installed explicitly by user.
+This variable is fed automatically by Emacs when installing a new package.
+This variable is used by `package-autoremove' to decide
+which packages are no longer needed.
+You can use it to (re)install packages on other machines
+by running `package-user-selected-packages-install'.
+
+To check if a package is contained in this list here, use
+`package--user-selected-p', as it may populate the variable with
+a sane initial value."
+ :group 'package
+ :type '(repeat symbol))
+
+\f
+;;; `package-desc' object definition
+;; This is the struct used internally to represent packages.
+;; Functions that deal with packages should generally take this object
+;; as an argument. In some situations (e.g. commands that query the
+;; user) it makes sense to take the package name as a symbol instead,
+;; but keep in mind there could be multiple `package-desc's with the
+;; same name.
(defvar package--default-summary "No description available.")
(cl-defstruct (package-desc
`version' Version of the package, as a version list.
`summary' Short description of the package, typically taken from
- the first line of the file.
+ the first line of the file.
`reqs' Requirements of the package. A list of (PACKAGE
- VERSION-LIST) naming the dependent package and the minimum
- required version.
+ VERSION-LIST) naming the dependent package and the minimum
+ required version.
`kind' The distribution format of the package. Currently, it is
- either `single' or `tar'.
+ either `single' or `tar'.
`archive' The name of the archive (as a string) whence this
- package came.
+ package came.
`dir' The directory where the package is installed (if installed),
- `builtin' if it is built-in, or nil otherwise.
+ `builtin' if it is built-in, or nil otherwise.
`extras' Optional alist of additional keyword-value pairs.
extras
signed)
+(defun package--from-builtin (bi-desc)
+ (package-desc-create :name (pop bi-desc)
+ :version (package--bi-desc-version bi-desc)
+ :summary (package--bi-desc-summary bi-desc)
+ :dir 'builtin))
+
;; Pseudo fields.
+(defun package-version-join (vlist)
+ "Return the version string corresponding to the list VLIST.
+This is, approximately, the inverse of `version-to-list'.
+\(Actually, it returns only one of the possible inverses, since
+`version-to-list' is a many-to-one operation.)"
+ (if (null vlist)
+ ""
+ (let ((str-list (list "." (int-to-string (car vlist)))))
+ (dolist (num (cdr vlist))
+ (cond
+ ((>= num 0)
+ (push (int-to-string num) str-list)
+ (push "." str-list))
+ ((< num -4)
+ (error "Invalid version list `%s'" vlist))
+ (t
+ ;; pre, or beta, or alpha
+ (cond ((equal "." (car str-list))
+ (pop str-list))
+ ((not (string-match "[0-9]+" (car str-list)))
+ (error "Invalid version list `%s'" vlist)))
+ (push (cond ((= num -1) "pre")
+ ((= num -2) "beta")
+ ((= num -3) "alpha")
+ ((= num -4) "snapshot"))
+ str-list))))
+ (if (equal "." (car str-list))
+ (pop str-list))
+ (apply 'concat (nreverse str-list)))))
+
(defun package-desc-full-name (pkg-desc)
(format "%s-%s"
(package-desc-name pkg-desc)
reqs
summary)
+\f
+;;; Installed packages
+;; The following variables store information about packages present in
+;; the system. The most important of these is `package-alist'. The
+;; command `package-initialize' is also closely related to this
+;; section, but it is left for a later section because it also affects
+;; other stuff.
(defvar package--builtins nil
"Alist of built-in packages.
The actual value is initialized by loading the library
"List of the names of currently activated packages.")
(put 'package-activated-list 'risky-local-variable t)
-(defun package-version-join (vlist)
- "Return the version string corresponding to the list VLIST.
-This is, approximately, the inverse of `version-to-list'.
-\(Actually, it returns only one of the possible inverses, since
-`version-to-list' is a many-to-one operation.)"
- (if (null vlist)
- ""
- (let ((str-list (list "." (int-to-string (car vlist)))))
- (dolist (num (cdr vlist))
- (cond
- ((>= num 0)
- (push (int-to-string num) str-list)
- (push "." str-list))
- ((< num -4)
- (error "Invalid version list `%s'" vlist))
- (t
- ;; pre, or beta, or alpha
- (cond ((equal "." (car str-list))
- (pop str-list))
- ((not (string-match "[0-9]+" (car str-list)))
- (error "Invalid version list `%s'" vlist)))
- (push (cond ((= num -1) "pre")
- ((= num -2) "beta")
- ((= num -3) "alpha")
- ((= num -4) "snapshot"))
- str-list))))
- (if (equal "." (car str-list))
- (pop str-list))
- (apply 'concat (nreverse str-list)))))
+;;;; Populating `package-alist'.
+;; The following functions are called on each installed package by
+;; `package-load-all-descriptors', which ultimately populates the
+;; `package-alist' variable.
+(defun package-process-define-package (exp)
+ (when (eq (car-safe exp) 'define-package)
+ (let* ((new-pkg-desc (apply #'package-desc-from-define (cdr exp)))
+ (name (package-desc-name new-pkg-desc))
+ (version (package-desc-version new-pkg-desc))
+ (old-pkgs (assq name package-alist)))
+ (if (null old-pkgs)
+ ;; If there's no old package, just add this to `package-alist'.
+ (push (list name new-pkg-desc) package-alist)
+ ;; If there is, insert the new package at the right place in the list.
+ (while
+ (if (and (cdr old-pkgs)
+ (version-list-< version
+ (package-desc-version (cadr old-pkgs))))
+ (setq old-pkgs (cdr old-pkgs))
+ (push new-pkg-desc (cdr old-pkgs))
+ nil)))
+ new-pkg-desc)))
(defun package-load-descriptor (pkg-dir)
"Load the description file in directory PKG-DIR."
(let ((pkg-file (expand-file-name (package--description-file pkg-dir)
pkg-dir))
- (signed-file (concat pkg-dir ".signed")))
+ (signed-file (concat pkg-dir ".signed")))
(when (file-exists-p pkg-file)
(with-temp-buffer
(insert-file-contents pkg-file)
(goto-char (point-min))
- (let ((pkg-desc (package-process-define-package
- (read (current-buffer)) pkg-file)))
+ (let ((pkg-desc (or (package-process-define-package
+ (read (current-buffer)))
+ (error "Can't find define-package in %s" pkg-file))))
(setf (package-desc-dir pkg-desc) pkg-dir)
- (if (file-exists-p signed-file)
- (setf (package-desc-signed pkg-desc) t))
+ (if (file-exists-p signed-file)
+ (setf (package-desc-signed pkg-desc) t))
pkg-desc)))))
(defun package-load-all-descriptors ()
(when (file-directory-p pkg-dir)
(package-load-descriptor pkg-dir)))))))
+(defun define-package (_name-string _version-string
+ &optional _docstring _requirements
+ &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.
+DOCSTRING is a short description of the package, a string.
+REQUIREMENTS is a list of dependencies on other packages.
+ Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION),
+ where OTHER-VERSION is a string.
+
+EXTRA-PROPERTIES is currently unused."
+ ;; FIXME: Placeholder! Should we keep it?
+ (error "Don't call me!"))
+
+\f
+;;; Package activation
+;; Section for functions used by `package-activate', which see.
(defun package-disabled-p (pkg-name version)
"Return whether PKG-NAME at VERSION can be activated.
The decision is made according to `package-load-list'.
force))
(t (error "Invalid element in `package-load-list'")))))
+(defun package-built-in-p (package &optional min-version)
+ "Return true if PACKAGE is built-in to Emacs.
+Optional arg MIN-VERSION, if non-nil, should be a version list
+specifying the minimum acceptable version."
+ (if (package-desc-p package) ;; was built-in and then was converted
+ (eq 'builtin (package-desc-dir package))
+ (let ((bi (assq package package--builtin-versions)))
+ (cond
+ (bi (version-list-<= min-version (cdr bi)))
+ ((remove 0 min-version) nil)
+ (t
+ (require 'finder-inf nil t) ; For `package--builtins'.
+ (assq package package--builtins))))))
+
+(defvar Info-directory-list)
+(declare-function info-initialize "info" ())
+
(defun package-activate-1 (pkg-desc &optional reload)
"Activate package given by PKG-DESC, even if it was already active.
If RELOAD is non-nil, also `load' any files inside the package which
correspond to previously loaded files (those returned by
`package--list-loaded-files')."
(let* ((name (package-desc-name pkg-desc))
- (pkg-dir (package-desc-dir pkg-desc))
+ (pkg-dir (package-desc-dir pkg-desc))
(pkg-dir-dir (file-name-as-directory pkg-dir)))
(unless pkg-dir
(error "Internal error: unable to find directory for `%s'"
- (package-desc-full-name pkg-desc)))
+ (package-desc-full-name pkg-desc)))
;; Add to load path, add autoloads, and activate the package.
(let* ((old-lp load-path)
(autoloads-file (expand-file-name
;; depends on this new definition, not doing this update would cause
;; compilation errors and break the installation.
(with-demoted-errors "Error in package-activate-1: %s"
- (mapc (lambda (feature) (load feature nil t))
+ (mapc (lambda (feature) (load feature nil t))
;; Skip autoloads file since we already evaluated it above.
(remove (file-truename autoloads-file) loaded-files-list))))
;; Add info node.
t))
(declare-function find-library-name "find-func" (library))
+
(defun package--list-loaded-files (dir)
"Recursively list all files in DIR which correspond to loaded features.
Returns the `file-name-sans-extension' of each file, relative to
;; Sort the files by ascending HISTORY-POSITION.
(lambda (x y) (< (cdr x) (cdr y))))))))
-(defun package-built-in-p (package &optional min-version)
- "Return true if PACKAGE is built-in to Emacs.
-Optional arg MIN-VERSION, if non-nil, should be a version list
-specifying the minimum acceptable version."
- (if (package-desc-p package) ;; was built-in and then was converted
- (eq 'builtin (package-desc-dir package))
- (let ((bi (assq package package--builtin-versions)))
- (cond
- (bi (version-list-<= min-version (cdr bi)))
- ((remove 0 min-version) nil)
- (t
- (require 'finder-inf nil t) ; For `package--builtins'.
- (assq package package--builtins))))))
-
-(defun package--from-builtin (bi-desc)
- (package-desc-create :name (pop bi-desc)
- :version (package--bi-desc-version bi-desc)
- :summary (package--bi-desc-summary bi-desc)
- :dir 'builtin))
-
-;; This function goes ahead and activates a newer version of a package
-;; if an older one was already activated. This is not ideal; we'd at
-;; least need to check to see if the package has actually been loaded,
-;; and not merely activated.
+;;;; `package-activate'
+;; This function activates a newer version of a package if an older
+;; one was already activated. It also loads a features of this
+;; package which were already loaded.
(defun package-activate (package &optional force)
"Activate package PACKAGE.
-If FORCE is true, (re-)activate it if it's already activated."
+If FORCE is true, (re-)activate it if it's already activated.
+Newer versions are always activated, regardless of FORCE."
(let ((pkg-descs (cdr (assq package package-alist))))
;; Check if PACKAGE is available in `package-alist'.
(while
(dolist (req (package-desc-reqs pkg-vec))
(unless (package-activate (car req))
(throw 'dep-failure req))))))
- (if fail
- (warn "Unable to activate package `%s'.
+ (if fail
+ (warn "Unable to activate package `%s'.
Required package `%s-%s' is unavailable"
- package (car fail) (package-version-join (cadr fail)))
- ;; If all goes well, activate the package itself.
- (package-activate-1 pkg-vec force)))))))
-
-(defun define-package (_name-string _version-string
- &optional _docstring _requirements
- &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.
-DOCSTRING is a short description of the package, a string.
-REQUIREMENTS is a list of dependencies on other packages.
- Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION),
- where OTHER-VERSION is a string.
-
-EXTRA-PROPERTIES is currently unused."
- ;; FIXME: Placeholder! Should we keep it?
- (error "Don't call me!"))
-
-(defun package-process-define-package (exp origin)
- (unless (eq (car-safe exp) 'define-package)
- (error "Can't find define-package in %s" origin))
- (let* ((new-pkg-desc (apply #'package-desc-from-define (cdr exp)))
- (name (package-desc-name new-pkg-desc))
- (version (package-desc-version new-pkg-desc))
- (old-pkgs (assq name package-alist)))
- (if (null old-pkgs)
- ;; If there's no old package, just add this to `package-alist'.
- (push (list name new-pkg-desc) package-alist)
- ;; If there is, insert the new package at the right place in the list.
- (while
- (if (and (cdr old-pkgs)
- (version-list-< version
- (package-desc-version (cadr old-pkgs))))
- (setq old-pkgs (cdr old-pkgs))
- (push new-pkg-desc (cdr old-pkgs))
- nil)))
- new-pkg-desc))
-
-;; From Emacs 22, but changed so it adds to load-path.
-(defun package-autoload-ensure-default-file (file)
- "Make sure that the autoload file FILE exists and if not create it."
- (unless (file-exists-p file)
- (write-region
- (concat ";;; " (file-name-nondirectory file)
- " --- automatically extracted autoloads\n"
- ";;\n"
- ";;; Code:\n"
- "(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))\n"
- "\f\n;; Local Variables:\n"
- ";; version-control: never\n"
- ";; no-byte-compile: t\n"
- ";; no-update-autoloads: t\n"
- ";; End:\n"
- ";;; " (file-name-nondirectory file)
- " ends here\n")
- nil file nil 'silent))
- file)
-
-(defvar generated-autoload-file)
-(defvar version-control)
+ package (car fail) (package-version-join (cadr fail)))
+ ;; If all goes well, activate the package itself.
+ (package-activate-1 pkg-vec force)))))))
-(defun package-generate-autoloads (name pkg-dir)
- (let* ((auto-name (format "%s-autoloads.el" name))
- ;;(ignore-name (concat name "-pkg.el"))
- (generated-autoload-file (expand-file-name auto-name pkg-dir))
- (backup-inhibited t)
- (version-control 'never))
- (package-autoload-ensure-default-file generated-autoload-file)
- (update-directory-autoloads pkg-dir)
- (let ((buf (find-buffer-visiting generated-autoload-file)))
- (when buf (kill-buffer buf)))
- auto-name))
+\f
+;;; Installation -- Local operations
+;; This section contains a variety of features regarding installing a
+;; package to/from disk. This includes autoload generation,
+;; unpacking, compiling, as well as defining a package from the
+;; current buffer.
+;;;; Unpacking
(defvar tar-parse-info)
(declare-function tar-untar-buffer "tar-mode" ())
(declare-function tar-header-name "tar-mode" (tar-header) t)
(tar-mode)
;; Make sure everything extracts into DIR.
(let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/"))
- (case-fold-search (memq system-type '(windows-nt ms-dos cygwin))))
+ (case-fold-search (memq system-type '(windows-nt ms-dos cygwin))))
(dolist (tar-data tar-parse-info)
(let ((name (expand-file-name (tar-header-name tar-data))))
- (or (string-match regexp name)
- ;; Tarballs created by some utilities don't list
- ;; directories with a trailing slash (Bug#13136).
- (and (string-equal dir name)
- (eq (tar-header-link-type tar-data) 5))
- (error "Package does not untar cleanly into directory %s/" dir)))))
+ (or (string-match regexp name)
+ ;; Tarballs created by some utilities don't list
+ ;; directories with a trailing slash (Bug#13136).
+ (and (string-equal dir name)
+ (eq (tar-header-link-type tar-data) 5))
+ (error "Package does not untar cleanly into directory %s/" dir)))))
(tar-untar-buffer))
-(defun package-generate-description-file (pkg-desc pkg-file)
- "Create the foo-pkg.el file for single-file packages."
- (let* ((name (package-desc-name pkg-desc)))
- (let ((print-level nil)
- (print-quoted t)
- (print-length nil))
- (write-region
- (concat
- ";;; -*- no-byte-compile: t -*-\n"
- (prin1-to-string
- (nconc
- (list 'define-package
- (symbol-name name)
- (package-version-join (package-desc-version pkg-desc))
- (package-desc-summary pkg-desc)
- (let ((requires (package-desc-reqs pkg-desc)))
- (list 'quote
- ;; Turn version lists into string form.
- (mapcar
- (lambda (elt)
- (list (car elt)
- (package-version-join (cadr elt))))
- requires))))
- (package--alist-to-plist-args
- (package-desc-extras pkg-desc))))
- "\n")
- nil pkg-file nil 'silent))))
-
(defun package--alist-to-plist-args (alist)
(mapcar 'macroexp-quote
(apply #'nconc
"Install the contents of the current buffer as a package."
(let* ((name (package-desc-name pkg-desc))
(dirname (package-desc-full-name pkg-desc))
- (pkg-dir (expand-file-name dirname package-user-dir)))
+ (pkg-dir (expand-file-name dirname package-user-dir)))
(pcase (package-desc-kind pkg-desc)
(`dir
(make-directory pkg-dir t)
(package-activate name 'force)
pkg-dir))
+(defun package-generate-description-file (pkg-desc pkg-file)
+ "Create the foo-pkg.el file for single-file packages."
+ (let* ((name (package-desc-name pkg-desc)))
+ (let ((print-level nil)
+ (print-quoted t)
+ (print-length nil))
+ (write-region
+ (concat
+ ";;; -*- no-byte-compile: t -*-\n"
+ (prin1-to-string
+ (nconc
+ (list 'define-package
+ (symbol-name name)
+ (package-version-join (package-desc-version pkg-desc))
+ (package-desc-summary pkg-desc)
+ (let ((requires (package-desc-reqs pkg-desc)))
+ (list 'quote
+ ;; Turn version lists into string form.
+ (mapcar
+ (lambda (elt)
+ (list (car elt)
+ (package-version-join (cadr elt))))
+ requires))))
+ (package--alist-to-plist-args
+ (package-desc-extras pkg-desc))))
+ "\n")
+ nil pkg-file nil 'silent))))
+
+;;;; Autoload
+;; From Emacs 22, but changed so it adds to load-path.
+(defun package-autoload-ensure-default-file (file)
+ "Make sure that the autoload file FILE exists and if not create it."
+ (unless (file-exists-p file)
+ (write-region
+ (concat ";;; " (file-name-nondirectory file)
+ " --- automatically extracted autoloads\n"
+ ";;\n"
+ ";;; Code:\n"
+ "(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))\n"
+ "\f\n;; Local Variables:\n"
+ ";; version-control: never\n"
+ ";; no-byte-compile: t\n"
+ ";; no-update-autoloads: t\n"
+ ";; End:\n"
+ ";;; " (file-name-nondirectory file)
+ " ends here\n")
+ nil file nil 'silent))
+ file)
+
+(defvar generated-autoload-file)
+(defvar version-control)
+
+(defun package-generate-autoloads (name pkg-dir)
+ (let* ((auto-name (format "%s-autoloads.el" name))
+ ;;(ignore-name (concat name "-pkg.el"))
+ (generated-autoload-file (expand-file-name auto-name pkg-dir))
+ (backup-inhibited t)
+ (version-control 'never))
+ (package-autoload-ensure-default-file generated-autoload-file)
+ (update-directory-autoloads pkg-dir)
+ (let ((buf (find-buffer-visiting generated-autoload-file)))
+ (when buf (kill-buffer buf)))
+ auto-name))
+
(defun package--make-autoloads-and-stuff (pkg-desc pkg-dir)
"Generate autoloads, description file, etc.. for PKG-DESC installed at PKG-DIR."
(package-generate-autoloads (package-desc-name pkg-desc) pkg-dir)
;; FIXME: Create foo.info and dir file from foo.texi?
)
+;;;; Compilation
(defun package--compile (pkg-desc)
"Byte-compile installed package PKG-DESC."
(package-activate-1 pkg-desc)
(byte-recompile-directory (package-desc-dir pkg-desc) 0 t))
-(defun package--write-file-no-coding (file-name)
- (let ((buffer-file-coding-system 'no-conversion))
- (write-region (point-min) (point-max) file-name nil 'silent)))
-
-(defmacro package--with-work-buffer (location file &rest body)
- "Run BODY in a buffer containing the contents of FILE at LOCATION.
-LOCATION is the base location of a package archive, and should be
-one of the URLs (or file names) specified in `package-archives'.
-FILE is the name of a file relative to that base location.
-
-This macro retrieves FILE from LOCATION into a temporary buffer,
-and evaluates BODY while that buffer is current. This work
-buffer is killed afterwards. Return the last value in BODY."
- (declare (indent 2) (debug t))
- `(with-temp-buffer
- (if (string-match-p "\\`https?:" ,location)
- (url-insert-file-contents (concat ,location ,file))
- (unless (file-name-absolute-p ,location)
- (error "Archive location %s is not an absolute file name"
- ,location))
- (insert-file-contents (expand-file-name ,file ,location)))
- ,@body))
+;;;; Inferring package from current buffer
+(defun package-read-from-string (str)
+ "Read a Lisp expression from STR.
+Signal an error if the entire string was not used."
+ (let* ((read-data (read-from-string str))
+ (more-left
+ (condition-case nil
+ ;; The call to `ignore' suppresses a compiler warning.
+ (progn (ignore (read-from-string
+ (substring str (cdr read-data))))
+ t)
+ (end-of-file nil))))
+ (if more-left
+ (error "Can't read whole string")
+ (car read-data))))
-(defun package--archive-file-exists-p (location file)
- (let ((http (string-match "\\`https?:" location)))
- (if http
- (progn
- (require 'url-http)
- (url-http-file-exists-p (concat location file)))
- (file-exists-p (expand-file-name file location)))))
+(defun package--prepare-dependencies (deps)
+ "Turn DEPS into an acceptable list of dependencies.
+
+Any parts missing a version string get a default version string
+of \"0\" (meaning any version) and an appropriate level of lists
+is wrapped around any parts requiring it."
+ (cond
+ ((not (listp deps))
+ (error "Invalid requirement specifier: %S" deps))
+ (t (mapcar (lambda (dep)
+ (cond
+ ((symbolp dep) `(,dep "0"))
+ ((stringp dep)
+ (error "Invalid requirement specifier: %S" dep))
+ ((and (listp dep) (null (cdr dep)))
+ (list (car dep) "0"))
+ (t dep)))
+ deps))))
+
+(declare-function lm-header "lisp-mnt" (header))
+(declare-function lm-homepage "lisp-mnt" ())
+
+(defun package-buffer-info ()
+ "Return a `package-desc' describing the package in the current buffer.
+
+If the buffer does not contain a conforming package, signal an
+error. If there is a package, narrow the buffer to the file's
+boundaries."
+ (goto-char (point-min))
+ (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t)
+ (error "Package lacks a file header"))
+ (let ((file-name (match-string-no-properties 1))
+ (desc (match-string-no-properties 2))
+ (start (line-beginning-position)))
+ (unless (search-forward (concat ";;; " file-name ".el ends here"))
+ (error "Package lacks a terminating comment"))
+ ;; Try to include a trailing newline.
+ (forward-line)
+ (narrow-to-region start (point))
+ (require 'lisp-mnt)
+ ;; Use some headers we've invented to drive the process.
+ (let* ((requires-str (lm-header "package-requires"))
+ ;; Prefer Package-Version; if defined, the package author
+ ;; probably wants us to use it. Otherwise try Version.
+ (pkg-version
+ (or (package-strip-rcs-id (lm-header "package-version"))
+ (package-strip-rcs-id (lm-header "version"))))
+ (homepage (lm-homepage)))
+ (unless pkg-version
+ (error
+ "Package lacks a \"Version\" or \"Package-Version\" header"))
+ (package-desc-from-define
+ file-name pkg-version desc
+ (if requires-str
+ (package--prepare-dependencies
+ (package-read-from-string requires-str)))
+ :kind 'single
+ :url homepage))))
+
+(defun package--read-pkg-desc (kind)
+ "Read a `define-package' form in current buffer.
+Return the pkg-desc, with desc-kind set to KIND."
+ (goto-char (point-min))
+ (unwind-protect
+ (let* ((pkg-def-parsed (read (current-buffer)))
+ (pkg-desc
+ (when (eq (car pkg-def-parsed) 'define-package)
+ (apply #'package-desc-from-define
+ (append (cdr pkg-def-parsed))))))
+ (when pkg-desc
+ (setf (package-desc-kind pkg-desc) kind)
+ pkg-desc))))
+
+(declare-function tar-get-file-descriptor "tar-mode" (file))
+(declare-function tar--extract "tar-mode" (descriptor))
+
+(defun package-tar-file-info ()
+ "Find package information for a tar file.
+The return result is a `package-desc'."
+ (cl-assert (derived-mode-p 'tar-mode))
+ (let* ((dir-name (file-name-directory
+ (tar-header-name (car tar-parse-info))))
+ (desc-file (package--description-file dir-name))
+ (tar-desc (tar-get-file-descriptor (concat dir-name desc-file))))
+ (unless tar-desc
+ (error "No package descriptor file found"))
+ (with-current-buffer (tar--extract tar-desc)
+ (unwind-protect
+ (or (package--read-pkg-desc 'tar)
+ (error "Can't find define-package in %s"
+ (tar-header-name tar-desc)))
+ (kill-buffer (current-buffer))))))
+
+(defun package-dir-info ()
+ "Find package information for a directory.
+The return result is a `package-desc'."
+ (cl-assert (derived-mode-p 'dired-mode))
+ (let* ((desc-file (package--description-file default-directory)))
+ (if (file-readable-p desc-file)
+ (with-temp-buffer
+ (insert-file-contents desc-file)
+ (package--read-pkg-desc 'dir))
+ (let ((files (directory-files default-directory t "\\.el\\'" t))
+ info)
+ (while files
+ (with-temp-buffer
+ (insert-file-contents (pop files))
+ ;; When we find the file with the data,
+ (when (setq info (ignore-errors (package-buffer-info)))
+ ;; stop looping,
+ (setq files nil)
+ ;; set the 'dir kind,
+ (setf (package-desc-kind info) 'dir))))
+ ;; and return the info.
+ info))))
+
+\f
+;;; Communicating with Archives
+;; Set of low-level functions for communicating with archives and
+;; signature checking.
+(defun package--write-file-no-coding (file-name)
+ (let ((buffer-file-coding-system 'no-conversion))
+ (write-region (point-min) (point-max) file-name nil 'silent)))
+
+(declare-function url-http-file-exists-p "url-http" (url))
+
+(defun package--archive-file-exists-p (location file)
+ (let ((http (string-match "\\`https?:" location)))
+ (if http
+ (progn
+ (require 'url-http)
+ (url-http-file-exists-p (concat location file)))
+ (file-exists-p (expand-file-name file location)))))
(declare-function epg-make-context "epg"
- (&optional protocol armor textmode include-certs
- cipher-algorithm
- digest-algorithm
- compress-algorithm))
+ (&optional protocol armor textmode include-certs
+ cipher-algorithm
+ digest-algorithm
+ compress-algorithm))
(declare-function epg-verify-string "epg" (context signature
- &optional signed-text))
+ &optional signed-text))
(declare-function epg-context-result-for "epg" (context name))
(declare-function epg-signature-status "epg" (signature))
(declare-function epg-signature-to-string "epg" (signature))
(unless (equal (epg-context-error-output context) "")
(with-output-to-temp-buffer "*Error*"
(with-current-buffer standard-output
- (if (epg-context-result-for context 'verify)
- (insert (format "Failed to verify signature %s:\n" sig-file)
- (mapconcat #'epg-signature-to-string
- (epg-context-result-for context 'verify)
- "\n"))
- (insert (format "Error while verifying signature %s:\n" sig-file)))
- (insert "\nCommand output:\n" (epg-context-error-output context))))))
-
-(defun package--check-signature (location file)
- "Check signature of the current buffer.
-GnuPG keyring is located under \"gnupg\" in `package-user-dir'."
+ (if (epg-context-result-for context 'verify)
+ (insert (format "Failed to verify signature %s:\n" sig-file)
+ (mapconcat #'epg-signature-to-string
+ (epg-context-result-for context 'verify)
+ "\n"))
+ (insert (format "Error while verifying signature %s:\n" sig-file)))
+ (insert "\nCommand output:\n" (epg-context-error-output context))))))
+
+(defmacro package--with-work-buffer (location file &rest body)
+ "Run BODY in a buffer containing the contents of FILE at LOCATION.
+LOCATION is the base location of a package archive, and should be
+one of the URLs (or file names) specified in `package-archives'.
+FILE is the name of a file relative to that base location.
+
+This macro retrieves FILE from LOCATION into a temporary buffer,
+and evaluates BODY while that buffer is current. This work
+buffer is killed afterwards. Return the last value in BODY."
+ (declare (indent 2) (debug t))
+ `(with-temp-buffer
+ (if (string-match-p "\\`https?:" ,location)
+ (url-insert-file-contents (concat ,location ,file))
+ (unless (file-name-absolute-p ,location)
+ (error "Archive location %s is not an absolute file name"
+ ,location))
+ (insert-file-contents (expand-file-name ,file ,location)))
+ ,@body))
+
+(defmacro package--with-work-buffer-async (location file async &rest body)
+ "Run BODY in a buffer containing the contents of FILE at LOCATION.
+If ASYNC is non-nil, and if it is possible, run BODY
+asynchronously. If an error is encountered and ASYNC is a
+function, call it with no arguments (instead of executing BODY),
+otherwise propagate the error. For description of the other
+arguments see `package--with-work-buffer'."
+ (declare (indent 3) (debug t))
+ (macroexp-let2* macroexp-copyable-p
+ ((async-1 async)
+ (file-1 file)
+ (location-1 location))
+ `(if (or (not ,async-1)
+ (not (string-match-p "\\`https?:" ,location-1)))
+ (package--with-work-buffer ,location-1 ,file-1 ,@body)
+ (url-retrieve (concat ,location-1 ,file-1)
+ (lambda (status)
+ (if (eq (car status) :error)
+ (if (functionp ,async-1)
+ (funcall ,async-1)
+ (signal (cdar status) (cddr status)))
+ (goto-char (point-min))
+ (unless (search-forward "\n\n" nil 'noerror)
+ (error "Invalid url response"))
+ (delete-region (point-min) (point))
+ ,@body)
+ (kill-buffer (current-buffer)))
+ nil
+ 'silent))))
+
+(defun package--check-signature-content (content string &optional sig-file)
+ "Check signature CONTENT against STRING.
+SIG-FILE is the name of the signature file, used when signaling
+errors."
(let* ((context (epg-make-context 'OpenPGP))
- (homedir (expand-file-name "gnupg" package-user-dir))
- (sig-file (concat file ".sig"))
- (sig-content (package--with-work-buffer location sig-file
- (buffer-string))))
+ (homedir (expand-file-name "gnupg" package-user-dir)))
(setf (epg-context-home-directory context) homedir)
(condition-case error
- (epg-verify-string context sig-content (buffer-string))
- (error
- (package--display-verify-error context sig-file)
- (signal (car error) (cdr error))))
+ (epg-verify-string context content string)
+ (error (package--display-verify-error context sig-file)
+ (signal (car error) (cdr error))))
(let (good-signatures had-fatal-error)
;; The .sig file may contain multiple signatures. Success if one
;; of the signatures is good.
(dolist (sig (epg-context-result-for context 'verify))
- (if (eq (epg-signature-status sig) 'good)
- (push sig good-signatures)
- ;; If package-check-signature is allow-unsigned, don't
- ;; signal error when we can't verify signature because of
- ;; missing public key. Other errors are still treated as
- ;; fatal (bug#17625).
- (unless (and (eq package-check-signature 'allow-unsigned)
- (eq (epg-signature-status sig) 'no-pubkey))
- (setq had-fatal-error t))))
+ (if (eq (epg-signature-status sig) 'good)
+ (push sig good-signatures)
+ ;; If package-check-signature is allow-unsigned, don't
+ ;; signal error when we can't verify signature because of
+ ;; missing public key. Other errors are still treated as
+ ;; fatal (bug#17625).
+ (unless (and (eq package-check-signature 'allow-unsigned)
+ (eq (epg-signature-status sig) 'no-pubkey))
+ (setq had-fatal-error t))))
(when (and (null good-signatures) had-fatal-error)
- (package--display-verify-error context sig-file)
- (error "Failed to verify signature %s" sig-file))
+ (package--display-verify-error context sig-file)
+ (error "Failed to verify signature %s" sig-file))
good-signatures)))
-(defun package-install-from-archive (pkg-desc)
- "Download and install a tar package."
- ;; This won't happen, unless the archive is doing something wrong.
- (when (eq (package-desc-kind pkg-desc) 'dir)
- (error "Can't install directory package from archive"))
- (let* ((location (package-archive-base pkg-desc))
- (file (concat (package-desc-full-name pkg-desc)
- (package-desc-suffix pkg-desc)))
- (sig-file (concat file ".sig"))
- good-signatures pkg-descs)
- (package--with-work-buffer location file
- (if (and package-check-signature
- (not (member (package-desc-archive pkg-desc)
- package-unsigned-archives)))
- (if (package--archive-file-exists-p location sig-file)
- (setq good-signatures (package--check-signature location file))
- (unless (eq package-check-signature 'allow-unsigned)
- (error "Unsigned package: `%s'"
- (package-desc-name pkg-desc)))))
- (package-unpack pkg-desc))
- ;; Here the package has been installed successfully, mark it as
- ;; signed if appropriate.
- (when good-signatures
- ;; Write out good signatures into NAME-VERSION.signed file.
- (write-region (mapconcat #'epg-signature-to-string good-signatures "\n")
- nil
- (expand-file-name
- (concat (package-desc-full-name pkg-desc)
- ".signed")
- package-user-dir)
- nil 'silent)
- ;; Update the old pkg-desc which will be shown on the description buffer.
- (setf (package-desc-signed pkg-desc) t)
- ;; Update the new (activated) pkg-desc as well.
- (setq pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist)))
- (if pkg-descs
- (setf (package-desc-signed (car pkg-descs)) t)))))
+(defun package--check-signature (location file &optional string async callback)
+ "Check signature of the current buffer.
+Download the signature file from LOCATION by appending \".sig\"
+to FILE.
+GnuPG keyring is located under \"gnupg\" in `package-user-dir'.
+STRING is the string to verify, it defaults to `buffer-string'.
+If ASYNC is non-nil, the download of the signature file is
+done asynchronously.
+
+If the signature is verified and CALLBACK was provided, CALLBACK
+is `funcall'ed with the list of good signatures as argument (the
+list can be empty). If the signatures file is not found,
+CALLBACK is called with no arguments."
+ (let ((sig-file (concat file ".sig"))
+ (string (or string (buffer-string))))
+ (condition-case nil
+ (package--with-work-buffer-async
+ location sig-file (when async (or callback t))
+ (let ((sig (package--check-signature-content
+ (buffer-string) string sig-file)))
+ (when callback (funcall callback sig))
+ sig))
+ (file-error (funcall callback)))))
+
+\f
+;;; Packages on Archives
+;; The following variables store information about packages available
+;; from archives. The most important of these is
+;; `package-archive-contents' which is initially populated by the
+;; function `package-read-all-archive-contents' from a cache on disk.
+;; The `package-initialize' command is also closely related to this
+;; section, but it has its own section.
+(defconst package-archive-version 1
+ "Version number of the package archive understood by this file.
+Lower version numbers than this will probably be understood as well.")
+
+;; We don't prime the cache since it tends to get out of date.
+(defvar package-archive-contents nil
+ "Cache of the contents of the Emacs Lisp Package Archive.
+This is an alist mapping package names (symbols) to
+non-empty lists of `package-desc' structures.")
+(put 'package-archive-contents 'risky-local-variable t)
+
+(defvar package--compatibility-table nil
+ "Hash table connecting package names to their compatibility.
+Each key is a symbol, the name of a package.
+
+The value is either nil, representing an incompatible package, or
+a version list, representing the highest compatible version of
+that package which is available.
+
+A package is considered incompatible if it requires an Emacs
+version higher than the one being used. To check for package
+\(in)compatibility, don't read this table directly, use
+`package--incompatible-p' which also checks dependencies.")
+
+(defun package--build-compatibility-table ()
+ "Build `package--compatibility-table' with `package--mapc'."
+ ;; Build compat table.
+ (setq package--compatibility-table (make-hash-table :test 'eq))
+ (package--mapc #'package--add-to-compatibility-table))
+
+(defun package--add-to-compatibility-table (pkg)
+ "If PKG is compatible (without dependencies), add to the compatibility table.
+PKG is a package-desc object.
+Only adds if its version is higher than what's already stored in
+the table."
+ (unless (package--incompatible-p pkg 'shallow)
+ (let* ((name (package-desc-name pkg))
+ (version (or (package-desc-version pkg) '(0)))
+ (table-version (gethash name package--compatibility-table)))
+ (when (or (not table-version)
+ (version-list-< table-version version))
+ (puthash name version package--compatibility-table)))))
+
+;; Package descriptor objects used inside the "archive-contents" file.
+;; Changing this defstruct implies changing the format of the
+;; "archive-contents" files.
+(cl-defstruct (package--ac-desc
+ (:constructor package-make-ac-desc (version reqs summary kind extras))
+ (:copier nil)
+ (:type vector))
+ version reqs summary kind extras)
+
+(defun package--append-to-alist (pkg-desc alist)
+ "Append an entry for PKG-DESC to the start of ALIST and return it.
+This entry takes the form (`package-desc-name' PKG-DESC).
+
+If ALIST already has an entry with this name, destructively add
+PKG-DESC to the cdr of this entry instead, sorted by version
+number."
+ (let* ((name (package-desc-name pkg-desc))
+ (priority-version (package-desc-priority-version pkg-desc))
+ (existing-packages (assq name alist)))
+ (if (not existing-packages)
+ (cons (list name pkg-desc)
+ alist)
+ (while (if (and (cdr existing-packages)
+ (version-list-< priority-version
+ (package-desc-priority-version
+ (cadr existing-packages))))
+ (setq existing-packages (cdr existing-packages))
+ (push pkg-desc (cdr existing-packages))
+ nil))
+ alist)))
+
+(defun package--add-to-archive-contents (package archive)
+ "Add the PACKAGE from the given ARCHIVE if necessary.
+PACKAGE should have the form (NAME . PACKAGE--AC-DESC).
+Also, add the originating archive to the `package-desc' structure."
+ (let* ((name (car package))
+ (version (package--ac-desc-version (cdr package)))
+ (pkg-desc
+ (package-desc-create
+ :name name
+ :version version
+ :reqs (package--ac-desc-reqs (cdr package))
+ :summary (package--ac-desc-summary (cdr package))
+ :kind (package--ac-desc-kind (cdr package))
+ :archive archive
+ :extras (and (> (length (cdr package)) 4)
+ ;; Older archive-contents files have only 4
+ ;; elements here.
+ (package--ac-desc-extras (cdr package)))))
+ (pinned-to-archive (assoc name package-pinned-packages)))
+ ;; Skip entirely if pinned to another archive.
+ (when (not (and pinned-to-archive
+ (not (equal (cdr pinned-to-archive) archive))))
+ (setq package-archive-contents
+ (package--append-to-alist pkg-desc package-archive-contents)))))
+
+(defun package--read-archive-file (file)
+ "Re-read archive file FILE, if it exists.
+Will return the data from the file, or nil if the file does not exist.
+Will throw an error if the archive version is too new."
+ (let ((filename (expand-file-name file package-user-dir)))
+ (when (file-exists-p filename)
+ (with-temp-buffer
+ (insert-file-contents-literally filename)
+ (let ((contents (read (current-buffer))))
+ (if (> (car contents) package-archive-version)
+ (error "Package archive version %d is higher than %d"
+ (car contents) package-archive-version))
+ (cdr contents))))))
+
+(defun package-read-archive-contents (archive)
+ "Re-read archive contents for ARCHIVE.
+If successful, set the variable `package-archive-contents'.
+If the archive version is too new, signal an error."
+ ;; Version 1 of 'archive-contents' is identical to our internal
+ ;; representation.
+ (let* ((contents-file (format "archives/%s/archive-contents" archive))
+ (contents (package--read-archive-file contents-file)))
+ (when contents
+ (dolist (package contents)
+ (package--add-to-archive-contents package archive)))))
+(defun package-read-all-archive-contents ()
+ "Re-read `archive-contents', if it exists.
+If successful, set `package-archive-contents'."
+ (setq package-archive-contents nil)
+ (dolist (archive package-archives)
+ (package-read-archive-contents (car archive))))
+
+;;;; Package Initialize
+;; A bit of a milestone. This brings together some of the above
+;; sections and populates all relevant lists of packages from contents
+;; available on disk.
(defvar package--initialized nil)
-(defun package-installed-p (package &optional min-version)
- "Return true if PACKAGE, of MIN-VERSION or newer, is installed.
-MIN-VERSION should be a version list."
- (unless package--initialized (error "package.el is not yet initialized!"))
- (or
- (let ((pkg-descs (cdr (assq package package-alist))))
- (and pkg-descs
- (version-list-<= min-version
- (package-desc-version (car pkg-descs)))))
- ;; Also check built-in packages.
- (package-built-in-p package min-version)))
+;;;###autoload
+(defun package-initialize (&optional no-activate)
+ "Load Emacs Lisp packages, and activate them.
+The variable `package-load-list' controls which packages to load.
+If optional arg NO-ACTIVATE is non-nil, don't activate packages."
+ (interactive)
+ (setq package-alist nil)
+ (package-load-all-descriptors)
+ (package-read-all-archive-contents)
+ (unless no-activate
+ (dolist (elt package-alist)
+ (package-activate (car elt))))
+ (setq package--initialized t)
+ ;; This uses `package--mapc' so it must be called after
+ ;; `package--initialized' is t.
+ (package--build-compatibility-table))
+
+\f
+;;;; Populating `package-archive-contents' from archives
+;; This subsection populates the variables listed above from the
+;; actual archives, instead of from a local cache.
+(defvar package--downloads-in-progress nil
+ "List of in-progress asynchronous downloads.")
+(declare-function epg-check-configuration "epg-config"
+ (config &optional minimum-version))
+(declare-function epg-configuration "epg-config" ())
+(declare-function epg-import-keys-from-file "epg" (context keys))
+
+;;;###autoload
+(defun package-import-keyring (&optional file)
+ "Import keys from FILE."
+ (interactive "fFile: ")
+ (setq file (expand-file-name file))
+ (let ((context (epg-make-context 'OpenPGP))
+ (homedir (expand-file-name "gnupg" package-user-dir)))
+ (with-file-modes 448
+ (make-directory homedir t))
+ (setf (epg-context-home-directory context) homedir)
+ (message "Importing %s..." (file-name-nondirectory file))
+ (epg-import-keys-from-file context file)
+ (message "Importing %s...done" (file-name-nondirectory file))))
+
+(defvar package--post-download-archives-hook nil
+ "Hook run after the archive contents are downloaded.
+Don't run this hook directly. It is meant to be run as part of
+`package--update-downloads-in-progress'.")
+(put 'package--post-download-archives-hook 'risky-local-variable t)
+
+(defun package--update-downloads-in-progress (entry)
+ "Remove ENTRY from `package--downloads-in-progress'.
+Once it's empty, run `package--post-download-archives-hook'."
+ ;; Keep track of the downloading progress.
+ (setq package--downloads-in-progress
+ (remove entry package--downloads-in-progress))
+ ;; If this was the last download, run the hook.
+ (unless package--downloads-in-progress
+ (package--build-compatibility-table)
+ (package-read-all-archive-contents)
+ ;; We message before running the hook, so the hook can give
+ ;; messages as well.
+ (message "Package refresh done")
+ (run-hooks 'package--post-download-archives-hook)))
+
+(defun package--download-one-archive (archive file &optional async)
+ "Retrieve an archive file FILE from ARCHIVE, and cache it.
+ARCHIVE should be a cons cell of the form (NAME . LOCATION),
+similar to an entry in `package-alist'. Save the cached copy to
+\"archives/NAME/FILE\" in `package-user-dir'."
+ (package--with-work-buffer-async (cdr archive) file async
+ (let* ((location (cdr archive))
+ (name (car archive))
+ (content (buffer-string))
+ (dir (expand-file-name (format "archives/%s" name) package-user-dir))
+ (local-file (expand-file-name file dir)))
+ (when (listp (read-from-string content))
+ (make-directory dir t)
+ (if (or (not package-check-signature)
+ (member archive package-unsigned-archives))
+ ;; If we don't care about the signature, save the file and
+ ;; we're done.
+ (progn (write-region content nil local-file nil 'silent)
+ (package--update-downloads-in-progress archive))
+ ;; If we care, check it (perhaps async) and *then* write the file.
+ (package--check-signature
+ location file content async
+ (lambda (&optional good-sigs)
+ (unless (or good-sigs (eq package-check-signature 'allow-unsigned))
+ (error "Unsigned archive `%s'" name))
+ ;; Write out the archives file.
+ (write-region content nil local-file nil 'silent)
+ ;; Write out good signatures into archive-contents.signed file.
+ (when good-sigs
+ (write-region (mapconcat #'epg-signature-to-string good-sigs "\n")
+ nil (concat local-file ".signed") nil 'silent))
+ (package--update-downloads-in-progress archive))))))))
+
+(defun package--download-and-read-archives (&optional async)
+ "Download descriptions of all `package-archives' and read them.
+This populates `package-archive-contents'. If ASYNC is non-nil,
+perform the downloads asynchronously."
+ ;; The downloaded archive contents will be read as part of
+ ;; `package--update-downloads-in-progress'.
+ (setq package--downloads-in-progress
+ (append package-archives
+ package--downloads-in-progress))
+ (dolist (archive package-archives)
+ (condition-case-unless-debug nil
+ (package--download-one-archive archive "archive-contents" async)
+ (error (message "Failed to download `%s' archive."
+ (car archive))))))
+
+;;;###autoload
+(defun package-refresh-contents (&optional async)
+ "Download descriptions of all configured ELPA packages.
+For each archive configured in the variable `package-archives',
+inform Emacs about the latest versions of all packages it offers,
+and make them available for download.
+Optional argument ASYNC specifies whether to perform the
+downloads in the background."
+ (interactive)
+ ;; FIXME: Do it asynchronously.
+ (unless (file-exists-p package-user-dir)
+ (make-directory package-user-dir t))
+ (let ((default-keyring (expand-file-name "package-keyring.gpg"
+ data-directory)))
+ (when (and package-check-signature (file-exists-p default-keyring))
+ (condition-case-unless-debug error
+ (progn
+ (epg-check-configuration (epg-configuration))
+ (package-import-keyring default-keyring))
+ (error (message "Cannot import default keyring: %S" (cdr error))))))
+ (package--download-and-read-archives async))
+
+\f
+;;; Dependency Management
+;; Calculating the full transaction necessary for an installation,
+;; keeping track of which packages were installed strictly as
+;; dependencies, and determining which packages cannot be removed
+;; because they are dependencies.
(defun package-compute-transaction (packages requirements &optional seen)
"Return a list of packages to be installed, including PACKAGES.
PACKAGES should be a list of `package-desc'.
;; older bar-1.3).
(dolist (elt requirements)
(let* ((next-pkg (car elt))
- (next-version (cadr elt))
+ (next-version (cadr elt))
(already ()))
(dolist (pkg packages)
(if (eq next-pkg (package-desc-name pkg))
((package-installed-p next-pkg next-version) nil)
(t
- ;; A package is required, but not installed. It might also be
- ;; blocked via `package-load-list'.
- (let ((pkg-descs (cdr (assq next-pkg package-archive-contents)))
+ ;; A package is required, but not installed. It might also be
+ ;; blocked via `package-load-list'.
+ (let ((pkg-descs (cdr (assq next-pkg package-archive-contents)))
(found nil)
(problem nil))
(while (and pkg-descs (not found))
(format "Required package '%s' is disabled"
next-pkg)))))
(t (setq found pkg-desc)))))
- (unless found
+ (unless found
(if problem
(error "%s" problem)
(error "Package `%s-%s' is unavailable"
- next-pkg (package-version-join next-version))))
- (setq packages
- (package-compute-transaction (cons found packages)
- (package-desc-reqs found)
- (cons found seen))))))))
- packages)
-
-(defun package-read-from-string (str)
- "Read a Lisp expression from STR.
-Signal an error if the entire string was not used."
- (let* ((read-data (read-from-string str))
- (more-left
- (condition-case nil
- ;; The call to `ignore' suppresses a compiler warning.
- (progn (ignore (read-from-string
- (substring str (cdr read-data))))
- t)
- (end-of-file nil))))
- (if more-left
- (error "Can't read whole string")
- (car read-data))))
-
-(defun package--read-archive-file (file)
- "Re-read archive file FILE, if it exists.
-Will return the data from the file, or nil if the file does not exist.
-Will throw an error if the archive version is too new."
- (let ((filename (expand-file-name file package-user-dir)))
- (when (file-exists-p filename)
- (with-temp-buffer
- (insert-file-contents-literally filename)
- (let ((contents (read (current-buffer))))
- (if (> (car contents) package-archive-version)
- (error "Package archive version %d is higher than %d"
- (car contents) package-archive-version))
- (cdr contents))))))
-
-(defun package-read-all-archive-contents ()
- "Re-read `archive-contents', if it exists.
-If successful, set `package-archive-contents'."
- (setq package-archive-contents nil)
- (dolist (archive package-archives)
- (package-read-archive-contents (car archive))))
-
-(defun package-read-archive-contents (archive)
- "Re-read archive contents for ARCHIVE.
-If successful, set the variable `package-archive-contents'.
-If the archive version is too new, signal an error."
- ;; Version 1 of 'archive-contents' is identical to our internal
- ;; representation.
- (let* ((contents-file (format "archives/%s/archive-contents" archive))
- (contents (package--read-archive-file contents-file)))
- (when contents
- (dolist (package contents)
- (package--add-to-archive-contents package archive)))))
-
-;; Package descriptor objects used inside the "archive-contents" file.
-;; Changing this defstruct implies changing the format of the
-;; "archive-contents" files.
-(cl-defstruct (package--ac-desc
- (:constructor package-make-ac-desc (version reqs summary kind extras))
- (:copier nil)
- (:type vector))
- version reqs summary kind extras)
-
-(defun package--add-to-archive-contents (package archive)
- "Add the PACKAGE from the given ARCHIVE if necessary.
-PACKAGE should have the form (NAME . PACKAGE--AC-DESC).
-Also, add the originating archive to the `package-desc' structure."
- (let* ((name (car package))
- (version (package--ac-desc-version (cdr package)))
- (pkg-desc
- (package-desc-create
- :name name
- :version version
- :reqs (package--ac-desc-reqs (cdr package))
- :summary (package--ac-desc-summary (cdr package))
- :kind (package--ac-desc-kind (cdr package))
- :archive archive
- :extras (and (> (length (cdr package)) 4)
- ;; Older archive-contents files have only 4
- ;; elements here.
- (package--ac-desc-extras (cdr package)))))
- (pinned-to-archive (assoc name package-pinned-packages)))
- ;; Skip entirely if pinned to another archive.
- (when (not (and pinned-to-archive
- (not (equal (cdr pinned-to-archive) archive))))
- (setq package-archive-contents
- (package--append-to-alist pkg-desc package-archive-contents)))))
+ next-pkg (package-version-join next-version))))
+ (setq packages
+ (package-compute-transaction (cons found packages)
+ (package-desc-reqs found)
+ (cons found seen))))))))
+ packages)
-(defun package--append-to-alist (pkg-desc alist)
- "Append an entry for PKG-DESC to the start of ALIST and return it.
-This entry takes the form (`package-desc-name' PKG-DESC).
+(defun package--find-non-dependencies ()
+ "Return a list of installed packages which are not dependencies.
+Finds all packages in `package-alist' which are not dependencies
+of any other packages.
+Used to populate `package-selected-packages'."
+ (let ((dep-list
+ (delete-dups
+ (apply #'append
+ (mapcar (lambda (p) (mapcar #'car (package-desc-reqs (cadr p))))
+ package-alist)))))
+ (cl-loop for p in package-alist
+ for name = (car p)
+ unless (memq name dep-list)
+ collect name)))
+
+(defun package--user-selected-p (pkg)
+ "Return non-nil if PKG is a package was installed by the user.
+PKG is a package name.
+This looks into `package-selected-packages', populating it first
+if it is still empty."
+ (unless (consp package-selected-packages)
+ (customize-save-variable
+ 'package-selected-packages
+ (setq package-selected-packages (package--find-non-dependencies))))
+ (memq pkg package-selected-packages))
+
+(defun package--get-deps (pkg &optional only)
+ (let* ((pkg-desc (cadr (assq pkg package-alist)))
+ (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc)
+ for name = (car p)
+ when (assq name package-alist)
+ collect name))
+ (indirect-deps (unless (eq only 'direct)
+ (delete-dups
+ (cl-loop for p in direct-deps
+ append (package--get-deps p))))))
+ (cl-case only
+ (direct direct-deps)
+ (separate (list direct-deps indirect-deps))
+ (indirect indirect-deps)
+ (t (delete-dups (append direct-deps indirect-deps))))))
+
+(defun package--removable-packages ()
+ "Return a list of names of packages no longer needed.
+These are packages which are neither contained in
+`package-selected-packages' nor a dependency of one that is."
+ (let ((needed (cl-loop for p in package-selected-packages
+ if (assq p package-alist)
+ ;; `p' and its dependencies are needed.
+ append (cons p (package--get-deps p)))))
+ (cl-loop for p in (mapcar #'car package-alist)
+ unless (memq p needed)
+ collect p)))
+
+(defun package--used-elsewhere-p (pkg-desc &optional pkg-list)
+ "Non-nil if PKG-DESC is a dependency of a package in PKG-LIST.
+Return the first package found in PKG-LIST of which PKG is a
+dependency.
+
+When not specified, PKG-LIST defaults to `package-alist'
+with PKG-DESC entry removed."
+ (unless (string= (package-desc-status pkg-desc) "obsolete")
+ (let ((pkg (package-desc-name pkg-desc)))
+ (cl-loop with alist = (or pkg-list
+ (remove (assq pkg package-alist)
+ package-alist))
+ for p in alist thereis
+ (and (memq pkg (mapcar #'car (package-desc-reqs (cadr p))))
+ (car p))))))
+
+(defun package--sort-deps-in-alist (package only)
+ "Return a list of dependencies for PACKAGE sorted by dependency.
+PACKAGE is included as the first element of the returned list.
+ONLY is an alist associating package names to package objects.
+Only these packages will be in the return value an their cdrs are
+destructively set to nil in ONLY."
+ (let ((out))
+ (dolist (dep (package-desc-reqs package))
+ (when-let ((cell (assq (car dep) only))
+ (dep-package (cdr-safe cell)))
+ (setcdr cell nil)
+ (setq out (append (package--sort-deps-in-alist dep-package only)
+ out))))
+ (cons package out)))
+
+(defun package--sort-by-dependence (package-list)
+ "Return PACKAGE-LIST sorted by dependence.
+That is, any element of the returned list is guaranteed to not
+directly depend on any elements that come before it.
+
+PACKAGE-LIST is a list of package-desc objects.
+Indirect dependencies are guaranteed to be returned in order only
+if all the in-between dependencies are also in PACKAGE-LIST."
+ (let ((alist (mapcar (lambda (p) (cons (package-desc-name p) p)) package-list))
+ out-list)
+ (dolist (cell alist out-list)
+ ;; `package--sort-deps-in-alist' destructively changes alist, so
+ ;; some cells might already be empty. We check this here.
+ (when-let ((pkg-desc (cdr cell)))
+ (setcdr cell nil)
+ (setq out-list
+ (append (package--sort-deps-in-alist pkg-desc alist)
+ out-list))))))
-If ALIST already has an entry with this name, destructively add
-PKG-DESC to the cdr of this entry instead, sorted by version
-number."
- (let* ((name (package-desc-name pkg-desc))
- (priority-version (package-desc-priority-version pkg-desc))
- (existing-packages (assq name alist)))
- (if (not existing-packages)
- (cons (list name pkg-desc)
- alist)
- (while (if (and (cdr existing-packages)
- (version-list-< priority-version
- (package-desc-priority-version
- (cadr existing-packages))))
- (setq existing-packages (cdr existing-packages))
- (push pkg-desc (cdr existing-packages))
- nil))
- alist)))
+\f
+;;; Installation Functions
+;; As opposed to the previous section (which listed some underlying
+;; functions necessary for installation), this one contains the actual
+;; functions that install packages. The package itself can be
+;; installed in a variety of ways (archives, buffer, file), but
+;; requirements (dependencies) are always satisfied by looking in
+;; `package-archive-contents'.
+(defun package-archive-base (desc)
+ "Return the archive containing the package NAME."
+ (cdr (assoc (package-desc-archive desc) package-archives)))
+
+(defun package-install-from-archive (pkg-desc)
+ "Download and install a tar package."
+ ;; This won't happen, unless the archive is doing something wrong.
+ (when (eq (package-desc-kind pkg-desc) 'dir)
+ (error "Can't install directory package from archive"))
+ (let* ((location (package-archive-base pkg-desc))
+ (file (concat (package-desc-full-name pkg-desc)
+ (package-desc-suffix pkg-desc)))
+ (sig-file (concat file ".sig"))
+ good-signatures pkg-descs)
+ (package--with-work-buffer location file
+ (if (and package-check-signature
+ (not (member (package-desc-archive pkg-desc)
+ package-unsigned-archives)))
+ (if (package--archive-file-exists-p location sig-file)
+ (setq good-signatures (package--check-signature location file))
+ (unless (eq package-check-signature 'allow-unsigned)
+ (error "Unsigned package: `%s'"
+ (package-desc-name pkg-desc)))))
+ (package-unpack pkg-desc))
+ ;; Here the package has been installed successfully, mark it as
+ ;; signed if appropriate.
+ (when good-signatures
+ ;; Write out good signatures into NAME-VERSION.signed file.
+ (write-region (mapconcat #'epg-signature-to-string good-signatures "\n")
+ nil
+ (expand-file-name
+ (concat (package-desc-full-name pkg-desc)
+ ".signed")
+ package-user-dir)
+ nil 'silent)
+ ;; Update the old pkg-desc which will be shown on the description buffer.
+ (setf (package-desc-signed pkg-desc) t)
+ ;; Update the new (activated) pkg-desc as well.
+ (setq pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist)))
+ (if pkg-descs
+ (setf (package-desc-signed (car pkg-descs)) t)))))
+
+(defun package-installed-p (package &optional min-version)
+ "Return true if PACKAGE, of MIN-VERSION or newer, is installed.
+If PACKAGE is a symbol, it is the package name and MIN-VERSION
+should be a version list.
+
+If PACKAGE is a package-desc object, MIN-VERSION is ignored."
+ (unless package--initialized (error "package.el is not yet initialized!"))
+ (if (package-desc-p package)
+ (let ((dir (package-desc-dir package)))
+ (and (stringp dir)
+ (file-exists-p dir)))
+ (or
+ (let ((pkg-descs (cdr (assq package package-alist))))
+ (and pkg-descs
+ (version-list-<= min-version
+ (package-desc-version (car pkg-descs)))))
+ ;; Also check built-in packages.
+ (package-built-in-p package min-version))))
(defun package-download-transaction (packages)
"Download and install all the packages in PACKAGES.
(mapc #'package-install-from-archive packages))
;;;###autoload
-(defun package-install (pkg)
+(defun package-install (pkg &optional dont-select)
"Install the package PKG.
PKG can be a package-desc or the package name of one the available packages
-in an archive in `package-archives'. Interactively, prompt for its name."
+in an archive in `package-archives'. Interactively, prompt for its name.
+
+If called interactively or if DONT-SELECT nil, add PKG to
+`package-selected-packages'.
+
+If PKG is a package-desc and it is already installed, don't try
+to install it but still mark it as selected."
(interactive
(progn
;; Initialize the package system to get the list of package
(unless (package-installed-p (car elt))
(symbol-name (car elt))))
package-archive-contents))
- nil t)))))
- (package-download-transaction
- (if (package-desc-p pkg)
- (package-compute-transaction (list pkg)
- (package-desc-reqs pkg))
+ nil t))
+ nil)))
+ (let ((name (if (package-desc-p pkg)
+ (package-desc-name pkg)
+ pkg)))
+ (unless (or dont-select (package--user-selected-p name))
+ (customize-save-variable 'package-selected-packages
+ (cons name package-selected-packages))))
+ (if (package-desc-p pkg)
+ (if (package-installed-p pkg)
+ (message "`%s' is already installed" (package-desc-full-name pkg))
+ (package-download-transaction
+ (package-compute-transaction (list pkg)
+ (package-desc-reqs pkg))))
+ (package-download-transaction
(package-compute-transaction ()
(list (list pkg))))))
(when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
(setq str (substring str (match-end 0))))
(condition-case nil
- (if (version-to-list str)
- str)
+ (if (version-to-list str)
+ str)
(error nil))))
(declare-function lm-homepage "lisp-mnt" (&optional file))
-(defun package--prepare-dependencies (deps)
- "Turn DEPS into an acceptable list of dependencies.
-
-Any parts missing a version string get a default version string
-of \"0\" (meaning any version) and an appropriate level of lists
-is wrapped around any parts requiring it."
- (cond
- ((not (listp deps))
- (error "Invalid requirement specifier: %S" deps))
- (t (mapcar (lambda (dep)
- (cond
- ((symbolp dep) `(,dep "0"))
- ((stringp dep)
- (error "Invalid requirement specifier: %S" dep))
- ((and (listp dep) (null (cdr dep)))
- (list (car dep) "0"))
- (t dep)))
- deps))))
-
-(defun package-buffer-info ()
- "Return a `package-desc' describing the package in the current buffer.
-
-If the buffer does not contain a conforming package, signal an
-error. If there is a package, narrow the buffer to the file's
-boundaries."
- (goto-char (point-min))
- (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t)
- (error "Package lacks a file header"))
- (let ((file-name (match-string-no-properties 1))
- (desc (match-string-no-properties 2))
- (start (line-beginning-position)))
- (unless (search-forward (concat ";;; " file-name ".el ends here"))
- (error "Package lacks a terminating comment"))
- ;; Try to include a trailing newline.
- (forward-line)
- (narrow-to-region start (point))
- (require 'lisp-mnt)
- ;; Use some headers we've invented to drive the process.
- (let* ((requires-str (lm-header "package-requires"))
- ;; Prefer Package-Version; if defined, the package author
- ;; probably wants us to use it. Otherwise try Version.
- (pkg-version
- (or (package-strip-rcs-id (lm-header "package-version"))
- (package-strip-rcs-id (lm-header "version"))))
- (homepage (lm-homepage)))
- (unless pkg-version
- (error
- "Package lacks a \"Version\" or \"Package-Version\" header"))
- (package-desc-from-define
- file-name pkg-version desc
- (if requires-str
- (package--prepare-dependencies
- (package-read-from-string requires-str)))
- :kind 'single
- :url homepage))))
-
-(declare-function tar-get-file-descriptor "tar-mode" (file))
-(declare-function tar--extract "tar-mode" (descriptor))
-
-(defun package-tar-file-info ()
- "Find package information for a tar file.
-The return result is a `package-desc'."
- (cl-assert (derived-mode-p 'tar-mode))
- (let* ((dir-name (file-name-directory
- (tar-header-name (car tar-parse-info))))
- (desc-file (package--description-file dir-name))
- (tar-desc (tar-get-file-descriptor (concat dir-name desc-file))))
- (unless tar-desc
- (error "No package descriptor file found"))
- (with-current-buffer (tar--extract tar-desc)
- (unwind-protect
- (package--read-pkg-desc 'tar)
- (kill-buffer (current-buffer))))))
-
-(defun package-dir-info ()
- "Find package information for a directory.
-The return result is a `package-desc'."
- (cl-assert (derived-mode-p 'dired-mode))
- (let* ((desc-file (package--description-file default-directory)))
- (if (file-readable-p desc-file)
- (with-temp-buffer
- (insert-file-contents desc-file)
- (package--read-pkg-desc 'dir))
- (let ((files (directory-files default-directory t "\\.el\\'" t))
- info)
- (while files
- (with-temp-buffer
- (insert-file-contents (pop files))
- ;; When we find the file with the data,
- (when (setq info (ignore-errors (package-buffer-info)))
- ;; stop looping,
- (setq files nil)
- ;; set the 'dir kind,
- (setf (package-desc-kind info) 'dir))))
- ;; and return the info.
- info))))
-
-(defun package--read-pkg-desc (kind)
- "Read a `define-package' form in current buffer.
-Return the pkg-desc, with desc-kind set to KIND."
- (goto-char (point-min))
- (unwind-protect
- (let* ((pkg-def-parsed (read (current-buffer)))
- (pkg-desc
- (if (not (eq (car pkg-def-parsed) 'define-package))
- (error "Can't find define-package in %s"
- (tar-header-name tar-desc))
- (apply #'package-desc-from-define
- (append (cdr pkg-def-parsed))))))
- (setf (package-desc-kind pkg-desc) kind)
- pkg-desc)))
-
-
;;;###autoload
(defun package-install-from-buffer ()
"Install a package from the current buffer.
Downloads and installs required packages as needed."
(interactive)
- (let ((pkg-desc
- (cond
- ((derived-mode-p 'dired-mode)
- ;; This is the only way a package-desc object with a `dir'
- ;; desc-kind can be created. Such packages can't be
- ;; uploaded or installed from archives, they can only be
- ;; installed from local buffers or directories.
- (package-dir-info))
- ((derived-mode-p 'tar-mode)
- (package-tar-file-info))
- (t
- (package-buffer-info)))))
+ (let* ((pkg-desc
+ (cond
+ ((derived-mode-p 'dired-mode)
+ ;; This is the only way a package-desc object with a `dir'
+ ;; desc-kind can be created. Such packages can't be
+ ;; uploaded or installed from archives, they can only be
+ ;; installed from local buffers or directories.
+ (package-dir-info))
+ ((derived-mode-p 'tar-mode)
+ (package-tar-file-info))
+ (t
+ (package-buffer-info))))
+ (name (package-desc-name pkg-desc)))
;; Download and install the dependencies.
(let* ((requires (package-desc-reqs pkg-desc))
(transaction (package-compute-transaction nil requires)))
(package-download-transaction transaction))
;; Install the package itself.
(package-unpack pkg-desc)
+ (unless (package--user-selected-p name)
+ (customize-save-variable 'package-selected-packages
+ (cons name package-selected-packages)))
pkg-desc))
;;;###autoload
(when (string-match "\\.tar\\'" file) (tar-mode)))
(package-install-from-buffer)))
-(defun package-delete (pkg-desc)
- (let ((dir (package-desc-dir pkg-desc)))
- (if (not (string-prefix-p (file-name-as-directory
- (expand-file-name package-user-dir))
- (expand-file-name dir)))
- ;; Don't delete "system" packages.
- (error "Package `%s' is a system package, not deleting"
- (package-desc-full-name pkg-desc))
- (delete-directory dir t t)
- ;; Remove NAME-VERSION.signed file.
- (let ((signed-file (concat dir ".signed")))
- (if (file-exists-p signed-file)
- (delete-file signed-file)))
- ;; Update package-alist.
- (let* ((name (package-desc-name pkg-desc))
- (pkgs (assq name package-alist)))
- (delete pkg-desc pkgs)
- (unless (cdr pkgs)
- (setq package-alist (delq pkgs package-alist))))
- (message "Package `%s' deleted." (package-desc-full-name pkg-desc)))))
-
-(defun package-archive-base (desc)
- "Return the archive containing the package NAME."
- (cdr (assoc (package-desc-archive desc) package-archives)))
-
-(defun package-archive-priority (archive)
- "Return the priority of ARCHIVE.
-
-The archive priorities are specified in
-`package-archive-priorities'. If not given there, the priority
-defaults to 0."
- (or (cdr (assoc archive package-archive-priorities))
- 0))
-
-(defun package-desc-priority-version (pkg-desc)
- "Return the version PKG-DESC with the archive priority prepended.
-
-This allows for easy comparison of package versions from
-different archives if archive priorities are meant to be taken in
-consideration."
- (cons (package-archive-priority
- (package-desc-archive pkg-desc))
- (package-desc-version pkg-desc)))
-
-(defun package--download-one-archive (archive file)
- "Retrieve an archive file FILE from ARCHIVE, and cache it.
-ARCHIVE should be a cons cell of the form (NAME . LOCATION),
-similar to an entry in `package-alist'. Save the cached copy to
-\"archives/NAME/archive-contents\" in `package-user-dir'."
- (let ((dir (expand-file-name (format "archives/%s" (car archive))
- package-user-dir))
- (sig-file (concat file ".sig"))
- good-signatures)
- (package--with-work-buffer (cdr archive) file
- ;; Check signature of archive-contents, if desired.
- (if (and package-check-signature
- (not (member archive package-unsigned-archives)))
- (if (package--archive-file-exists-p (cdr archive) sig-file)
- (setq good-signatures (package--check-signature (cdr archive)
- file))
- (unless (eq package-check-signature 'allow-unsigned)
- (error "Unsigned archive `%s'"
- (car archive)))))
- ;; Read the retrieved buffer to make sure it is valid (e.g. it
- ;; may fetch a URL redirect page).
- (when (listp (read (current-buffer)))
- (make-directory dir t)
- (write-region nil nil (expand-file-name file dir) nil 'silent)))
- (when good-signatures
- ;; Write out good signatures into archive-contents.signed file.
- (write-region (mapconcat #'epg-signature-to-string good-signatures "\n")
- nil
- (expand-file-name (concat file ".signed") dir)
- nil 'silent))))
+;;;###autoload
+(defun package-install-user-selected-packages ()
+ "Ensure packages in `package-selected-packages' are installed.
+If some packages are not installed propose to install them."
+ (interactive)
+ ;; We don't need to populate `package-selected-packages' before
+ ;; using here, because the outcome is the same either way (nothing
+ ;; gets installed).
+ (if (not package-selected-packages)
+ (message "`package-selected-packages' is empty, nothing to install")
+ (cl-loop for p in package-selected-packages
+ unless (package-installed-p p)
+ collect p into lst
+ finally
+ (if lst
+ (when (y-or-n-p
+ (format "%s packages will be installed:\n%s, proceed?"
+ (length lst)
+ (mapconcat #'symbol-name lst ", ")))
+ (mapc #'package-install lst))
+ (message "All your packages are already installed")))))
-(declare-function epg-check-configuration "epg-config"
- (config &optional minimum-version))
-(declare-function epg-configuration "epg-config" ())
-(declare-function epg-import-keys-from-file "epg" (context keys))
+\f
+;;; Package Deletion
+(defun package--newest-p (pkg)
+ "Return t if PKG is the newest package with its name."
+ (equal (cadr (assq (package-desc-name pkg) package-alist))
+ pkg))
+
+(defun package-delete (pkg-desc &optional force nosave)
+ "Delete package PKG-DESC.
+
+Argument PKG-DESC is a full description of package as vector.
+When package is used elsewhere as dependency of another package,
+refuse deleting it and return an error.
+If FORCE is non-nil package will be deleted even if it is used
+elsewhere.
+If NOSAVE is non-nil, the package is not removed from
+`package-selected-packages'."
+ (let ((dir (package-desc-dir pkg-desc))
+ (name (package-desc-name pkg-desc))
+ pkg-used-elsewhere-by)
+ ;; If the user is trying to delete this package, they definitely
+ ;; don't want it marked as selected, so we remove it from
+ ;; `package-selected-packages' even if it can't be deleted.
+ (when (and (null nosave)
+ (package--user-selected-p name)
+ ;; Don't deselect if this is an older version of an
+ ;; upgraded package.
+ (package--newest-p pkg-desc))
+ (customize-save-variable
+ 'package-selected-packages (remove name package-selected-packages)))
+ (cond ((not (string-prefix-p (file-name-as-directory
+ (expand-file-name package-user-dir))
+ (expand-file-name dir)))
+ ;; Don't delete "system" packages.
+ (error "Package `%s' is a system package, not deleting"
+ (package-desc-full-name pkg-desc)))
+ ((and (null force)
+ (setq pkg-used-elsewhere-by
+ (package--used-elsewhere-p pkg-desc)))
+ ;; Don't delete packages used as dependency elsewhere.
+ (error "Package `%s' is used by `%s' as dependency, not deleting"
+ (package-desc-full-name pkg-desc)
+ pkg-used-elsewhere-by))
+ (t
+ (delete-directory dir t t)
+ ;; Remove NAME-VERSION.signed file.
+ (let ((signed-file (concat dir ".signed")))
+ (if (file-exists-p signed-file)
+ (delete-file signed-file)))
+ ;; Update package-alist.
+ (let ((pkgs (assq name package-alist)))
+ (delete pkg-desc pkgs)
+ (unless (cdr pkgs)
+ (setq package-alist (delq pkgs package-alist))))
+ (message "Package `%s' deleted." (package-desc-full-name pkg-desc))))))
;;;###autoload
-(defun package-import-keyring (&optional file)
- "Import keys from FILE."
- (interactive "fFile: ")
- (setq file (expand-file-name file))
- (let ((context (epg-make-context 'OpenPGP))
- (homedir (expand-file-name "gnupg" package-user-dir)))
- (with-file-modes 448
- (make-directory homedir t))
- (setf (epg-context-home-directory context) homedir)
- (message "Importing %s..." (file-name-nondirectory file))
- (epg-import-keys-from-file context file)
- (message "Importing %s...done" (file-name-nondirectory file))))
+(defun package-reinstall (pkg)
+ "Reinstall package PKG.
+PKG should be either a symbol, the package name, or a package-desc
+object."
+ (interactive (list (intern (completing-read
+ "Reinstall package: "
+ (mapcar #'symbol-name
+ (mapcar #'car package-alist))))))
+ (package-delete
+ (if (package-desc-p pkg) pkg (cadr (assq pkg package-alist)))
+ 'force 'nosave)
+ (package-install pkg 'dont-select))
;;;###autoload
-(defun package-refresh-contents ()
- "Download the ELPA archive description if needed.
-This informs Emacs about the latest versions of all packages, and
-makes them available for download."
- (interactive)
- ;; FIXME: Do it asynchronously.
- (unless (file-exists-p package-user-dir)
- (make-directory package-user-dir t))
- (let ((default-keyring (expand-file-name "package-keyring.gpg"
- data-directory)))
- (when (and package-check-signature (file-exists-p default-keyring))
- (condition-case-unless-debug error
- (progn
- (epg-check-configuration (epg-configuration))
- (package-import-keyring default-keyring))
- (error (message "Cannot import default keyring: %S" (cdr error))))))
- (dolist (archive package-archives)
- (condition-case-unless-debug nil
- (package--download-one-archive archive "archive-contents")
- (error (message "Failed to download `%s' archive."
- (car archive)))))
- (package-read-all-archive-contents))
+(defun package-autoremove ()
+ "Remove packages that are no more needed.
-;;;###autoload
-(defun package-initialize (&optional no-activate)
- "Load Emacs Lisp packages, and activate them.
-The variable `package-load-list' controls which packages to load.
-If optional arg NO-ACTIVATE is non-nil, don't activate packages."
+Packages that are no more needed by other packages in
+`package-selected-packages' and their dependencies
+will be deleted."
(interactive)
- (setq package-alist nil)
- (package-load-all-descriptors)
- (package-read-all-archive-contents)
- (unless no-activate
- (dolist (elt package-alist)
- (package-activate (car elt))))
- (setq package--initialized t))
+ ;; If `package-selected-packages' is nil, it would make no sense to
+ ;; try to populate it here, because then `package-autoremove' will
+ ;; do absolutely nothing.
+ (when (or package-selected-packages
+ (yes-or-no-p
+ "`package-selected-packages' is empty! Really remove ALL packages? "))
+ (let ((removable (package--removable-packages)))
+ (if removable
+ (when (y-or-n-p
+ (format "%s packages will be deleted:\n%s, proceed? "
+ (length removable)
+ (mapconcat #'symbol-name removable ", ")))
+ (mapc (lambda (p)
+ (package-delete (cadr (assq p package-alist)) t))
+ removable))
+ (message "Nothing to autoremove")))))
\f
;;;; Package description buffer.
(if (not (or (package-desc-p package) (and package (symbolp package))))
(message "No package specified")
(help-setup-xref (list #'describe-package package)
- (called-interactively-p 'interactive))
+ (called-interactively-p 'interactive))
(with-help-window (help-buffer)
(with-current-buffer standard-output
- (describe-package-1 package)))))
+ (describe-package-1 package)))))
+
+(declare-function lm-commentary "lisp-mnt" (&optional file))
(defun describe-package-1 (pkg)
(require 'lisp-mnt)
(built-in (eq pkg-dir 'builtin))
(installable (and archive (not built-in)))
(status (if desc (package-desc-status desc) "orphan"))
+ (incompatible-reason (package--incompatible-p desc))
(signed (if desc (package-desc-signed desc))))
+ (when incompatible-reason
+ (setq status "incompatible"))
(prin1 name)
(princ " is ")
(princ (if (memq (aref status 0) '(?a ?e ?i ?o ?u)) "an " "a "))
(insert " " (propertize "Status" 'font-lock-face 'bold) ": ")
(cond (built-in
- (insert (propertize (capitalize status)
+ (insert (propertize (capitalize status)
'font-lock-face 'font-lock-builtin-face)
"."))
- (pkg-dir
- (insert (propertize (if (equal status "unsigned")
- "Installed"
- (capitalize status)) ;FIXME: Why comment-face?
- 'font-lock-face 'font-lock-comment-face))
- (insert " in `")
- ;; Todo: Add button for uninstalling.
- (help-insert-xref-button (abbreviate-file-name
+ (pkg-dir
+ (insert (propertize (if (member status '("unsigned" "dependency"))
+ "Installed"
+ (capitalize status)) ;FIXME: Why comment-face?
+ 'font-lock-face 'font-lock-comment-face))
+ (insert " in `")
+ ;; Todo: Add button for uninstalling.
+ (help-insert-xref-button (abbreviate-file-name
(file-name-as-directory pkg-dir))
- 'help-package-def pkg-dir)
- (if (and (package-built-in-p name)
+ 'help-package-def pkg-dir)
+ (if (and (package-built-in-p name)
(not (package-built-in-p name version)))
- (insert "',\n shadowing a "
- (propertize "built-in package"
- 'font-lock-face 'font-lock-builtin-face))
- (insert "'"))
- (if signed
- (insert ".")
- (insert " (unsigned).")))
- (installable
+ (insert "',\n shadowing a "
+ (propertize "built-in package"
+ 'font-lock-face 'font-lock-builtin-face))
+ (insert "'"))
+ (if signed
+ (insert ".")
+ (insert " (unsigned).")))
+ (incompatible-reason
+ (insert (propertize "Incompatible" 'face font-lock-warning-face)
+ " because it depends on ")
+ (if (stringp incompatible-reason)
+ (insert "Emacs " incompatible-reason ".")
+ (insert "uninstallable packages.")))
+ (installable
(insert (capitalize status))
- (insert " from " (format "%s" archive))
- (insert " -- ")
+ (insert " from " (format "%s" archive))
+ (insert " -- ")
(package-make-button
"Install"
'action 'package-install-button-action
'package-desc desc))
- (t (insert (capitalize status) ".")))
+ (t (insert (capitalize status) ".")))
(insert "\n")
(insert " " (propertize "Archive" 'font-lock-face 'bold)
- ": " (or archive "n/a") "\n")
+ ": " (or archive "n/a") "\n")
(and version
- (insert " "
- (propertize "Version" 'font-lock-face 'bold) ": "
+ (insert " "
+ (propertize "Version" 'font-lock-face 'bold) ": "
(package-version-join version) "\n"))
(setq reqs (if desc (package-desc-reqs desc)))
(when reqs
(insert " " (propertize "Requires" 'font-lock-face 'bold) ": ")
- (let ((first t)
- name vers text)
- (dolist (req reqs)
- (setq name (car req)
- vers (cadr req)
- text (format "%s-%s" (symbol-name name)
- (package-version-join vers)))
- (cond (first (setq first nil))
- ((>= (+ 2 (current-column) (length text))
- (window-width))
- (insert ",\n "))
- (t (insert ", ")))
- (help-insert-xref-button text 'help-package name))
- (insert "\n")))
+ (let ((first t))
+ (dolist (req reqs)
+ (let* ((name (car req))
+ (vers (cadr req))
+ (text (format "%s-%s" (symbol-name name)
+ (package-version-join vers)))
+ (reason (if (and (listp incompatible-reason)
+ (assq name incompatible-reason))
+ " (not available)" "")))
+ (cond (first (setq first nil))
+ ((>= (+ 2 (current-column) (length text) (length reason))
+ (window-width))
+ (insert ",\n "))
+ (t (insert ", ")))
+ (help-insert-xref-button text 'help-package name)
+ (insert reason)))
+ (insert "\n")))
(insert " " (propertize "Summary" 'font-lock-face 'bold)
- ": " (if desc (package-desc-summary desc)) "\n")
+ ": " (if desc (package-desc-summary desc)) "\n")
(when homepage
(insert " " (propertize "Homepage" 'font-lock-face 'bold) ": ")
(help-insert-xref-button homepage 'help-url homepage)
(insert "\n")
(if built-in
- ;; For built-in packages, insert the commentary.
- (let ((fn (locate-file (format "%s.el" name) load-path
- load-file-rep-suffixes))
- (opoint (point)))
- (insert (or (lm-commentary fn) ""))
- (save-excursion
- (goto-char opoint)
- (when (re-search-forward "^;;; Commentary:\n" nil t)
- (replace-match ""))
- (while (re-search-forward "^\\(;+ ?\\)" nil t)
- (replace-match ""))))
+ ;; For built-in packages, insert the commentary.
+ (let ((fn (locate-file (format "%s.el" name) load-path
+ load-file-rep-suffixes))
+ (opoint (point)))
+ (insert (or (lm-commentary fn) ""))
+ (save-excursion
+ (goto-char opoint)
+ (when (re-search-forward "^;;; Commentary:\n" nil t)
+ (replace-match ""))
+ (while (re-search-forward "^\\(;+ ?\\)" nil t)
+ (replace-match ""))))
(let ((readme (expand-file-name (format "%s-readme.txt" name)
- package-user-dir))
- readme-string)
- ;; For elpa packages, try downloading the commentary. If that
- ;; fails, try an existing readme file in `package-user-dir'.
- (cond ((condition-case nil
+ package-user-dir))
+ readme-string)
+ ;; For elpa packages, try downloading the commentary. If that
+ ;; fails, try an existing readme file in `package-user-dir'.
+ (cond ((condition-case nil
(save-excursion
(package--with-work-buffer
(package-archive-base desc)
nil 'silent)
(setq readme-string (buffer-string))
t))
- (error nil))
- (insert readme-string))
- ((file-readable-p readme)
- (insert-file-contents readme)
- (goto-char (point-max))))))))
+ (error nil))
+ (insert readme-string))
+ ((file-readable-p readme)
+ (insert-file-contents readme)
+ (goto-char (point-max))))))))
(defun package-install-button-action (button)
(let ((pkg-desc (button-get button 'package-desc)))
(when (y-or-n-p (format "Install package `%s'? "
(package-desc-full-name pkg-desc)))
- (package-install pkg-desc)
+ (package-install pkg-desc nil)
(revert-buffer nil t)
(goto-char (point-min)))))
(defvar package-menu-mode-map
(let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap "Package")))
+ (menu-map (make-sparse-keymap "Package")))
(set-keymap-parent map tabulated-list-mode-map)
(define-key map "\C-m" 'package-menu-describe-package)
(define-key map "u" 'package-menu-mark-unmark)
(define-key map [menu-bar package-menu] (cons "Package" menu-map))
(define-key menu-map [mq]
'(menu-item "Quit" quit-window
- :help "Quit package selection"))
+ :help "Quit package selection"))
(define-key menu-map [s1] '("--"))
(define-key menu-map [mn]
'(menu-item "Next" next-line
- :help "Next Line"))
+ :help "Next Line"))
(define-key menu-map [mp]
'(menu-item "Previous" previous-line
- :help "Previous Line"))
+ :help "Previous Line"))
(define-key menu-map [s2] '("--"))
(define-key menu-map [mu]
'(menu-item "Unmark" package-menu-mark-unmark
- :help "Clear any marks on a package and move to the next line"))
+ :help "Clear any marks on a package and move to the next line"))
(define-key menu-map [munm]
'(menu-item "Unmark Backwards" package-menu-backup-unmark
- :help "Back up one line and clear any marks on that package"))
+ :help "Back up one line and clear any marks on that package"))
(define-key menu-map [md]
'(menu-item "Mark for Deletion" package-menu-mark-delete
- :help "Mark a package for deletion and move to the next line"))
+ :help "Mark a package for deletion and move to the next line"))
(define-key menu-map [mi]
'(menu-item "Mark for Install" package-menu-mark-install
- :help "Mark a package for installation and move to the next line"))
+ :help "Mark a package for installation and move to the next line"))
(define-key menu-map [mupgrades]
'(menu-item "Mark Upgradable Packages" package-menu-mark-upgrades
- :help "Mark packages that have a newer version for upgrading"))
+ :help "Mark packages that have a newer version for upgrading"))
(define-key menu-map [s3] '("--"))
(define-key menu-map [mf]
'(menu-item "Filter Package List..." package-menu-filter
- :help "Filter package selection (q to go back)"))
+ :help "Filter package selection (q to go back)"))
(define-key menu-map [mg]
'(menu-item "Update Package List" revert-buffer
- :help "Update the list of packages"))
+ :help "Update the list of packages"))
(define-key menu-map [mr]
'(menu-item "Refresh Package List" package-menu-refresh
- :help "Download the ELPA archive"))
+ :help "Download the ELPA archive"))
(define-key menu-map [s4] '("--"))
(define-key menu-map [mt]
'(menu-item "Mark Obsolete Packages" package-menu-mark-obsolete-for-deletion
- :help "Mark all obsolete packages for deletion"))
+ :help "Mark all obsolete packages for deletion"))
(define-key menu-map [mx]
'(menu-item "Execute Actions" package-menu-execute
- :help "Perform all the marked actions"))
+ :help "Perform all the marked actions"))
(define-key menu-map [s5] '("--"))
(define-key menu-map [mh]
'(menu-item "Help" package-menu-quick-help
- :help "Show short key binding help for package-menu-mode"))
+ :help "Show short key binding help for package-menu-mode"))
(define-key menu-map [mc]
'(menu-item "Describe Package" package-menu-describe-package
- :help "Display information about this package"))
+ :help "Display information about this package"))
map)
"Local keymap for `package-menu-mode' buffers.")
-(defvar package-menu--new-package-list nil
+(defvar-local 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"
(defvar package-list-unsigned nil
"If non-nil, mention in the list which packages were installed w/o signature.")
+(defvar package--emacs-version-list (version-to-list emacs-version)
+ "`emacs-version', as a list.")
+
+(defun package--incompatible-p (pkg &optional shallow)
+ "Return non-nil if PKG has no chance of being installable.
+PKG is a package-desc object.
+
+If SHALLOW is non-nil, this only checks if PKG depends on a
+higher `emacs-version' than the one being used. Otherwise, also
+checks the viability of dependencies, according to
+`package--compatibility-table'.
+
+If PKG requires an incompatible Emacs version, the return value
+is this version (as a string).
+If PKG requires incompatible packages, the return value is a list
+of these dependencies, similar to the list returned by
+`package-desc-reqs'."
+ (let* ((reqs (package-desc-reqs pkg))
+ (version (cadr (assq 'emacs reqs))))
+ (if (and version (version-list-< package--emacs-version-list version))
+ (package-version-join version)
+ (unless shallow
+ (let (out)
+ (dolist (dep (package-desc-reqs pkg) out)
+ (let ((dep-name (car dep)))
+ (unless (eq 'emacs dep-name)
+ (let ((cv (gethash dep-name package--compatibility-table)))
+ (when (version-list-< (or cv '(0)) (or (cadr dep) '(0)))
+ (push dep out)))))))))))
+
(defun package-desc-status (pkg-desc)
(let* ((name (package-desc-name pkg-desc))
(dir (package-desc-dir pkg-desc))
(lle (assq name package-load-list))
(held (cadr lle))
(version (package-desc-version pkg-desc))
- (signed (package-desc-signed pkg-desc)))
+ (signed (or (not package-list-unsigned)
+ (package-desc-signed pkg-desc))))
(cond
((eq dir 'builtin) "built-in")
((and lle (null held)) "disabled")
((version-list-< version hv) "obsolete")
(t "disabled"))))
((package-built-in-p name version) "obsolete")
+ ((package--incompatible-p pkg-desc) "incompat")
(dir ;One of the installed packages.
(cond
((not (file-exists-p (package-desc-dir pkg-desc))) "deleted")
((eq pkg-desc (cadr (assq name package-alist)))
- (if (or (not package-list-unsigned) signed) "installed" "unsigned"))
+ (if (not signed) "unsigned"
+ (if (package--user-selected-p name)
+ "installed" "dependency")))
(t "obsolete")))
(t
(let* ((ins (cadr (assq name package-alist)))
"new" "available"))
((version-list-< version ins-v) "obsolete")
((version-list-= version ins-v)
- (if (or (not package-list-unsigned) signed)
- "installed" "unsigned"))))))))
+ (if (not signed) "unsigned"
+ (if (package--user-selected-p name)
+ "installed" "dependency")))))))))
(defun package-menu--refresh (&optional packages keywords)
"Re-populate the `tabulated-list-entries'.
(package--has-keyword-p (package--from-builtin elt) keywords)
(or package-list-unversioned
(package--bi-desc-version (cdr elt)))
- (or (eq packages t) (memq name packages)))
- (package--push (package--from-builtin elt) "built-in" info-list)))
+ (or (eq packages t) (memq name packages)))
+ (package--push (package--from-builtin elt) "built-in" info-list)))
;; Available and disabled packages:
(dolist (elt package-archive-contents)
(when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
(or package-list-unversioned
(package--bi-desc-version (cdr elt)))
- (or (eq packages t) (memq name packages)))
+ (or (eq packages t) (memq name packages)))
(funcall function (package--from-builtin elt))))
;; Available and disabled packages:
PKG has the form (PKG-DESC . STATUS).
Return (PKG-DESC [NAME VERSION STATUS DOC])."
(let* ((pkg-desc (car pkg))
- (status (cdr pkg))
- (face (pcase status
+ (status (cdr pkg))
+ (face (pcase status
(`"built-in" 'font-lock-builtin-face)
(`"available" 'default)
(`"new" 'bold)
(`"held" 'font-lock-constant-face)
(`"disabled" 'font-lock-warning-face)
(`"installed" 'font-lock-comment-face)
+ (`"dependency" 'font-lock-comment-face)
(`"unsigned" 'font-lock-warning-face)
+ (`"incompat" 'font-lock-comment-face)
(_ 'font-lock-warning-face)))) ; obsolete.
(list pkg-desc
- `[,(list (symbol-name (package-desc-name pkg-desc))
+ `[,(list (symbol-name (package-desc-name pkg-desc))
'face 'link
'follow-link t
'package-desc pkg-desc
If optional arg BUTTON is non-nil, describe its associated package."
(interactive)
(let ((pkg-desc (if button (button-get button 'package-desc)
- (tabulated-list-get-id))))
+ (tabulated-list-get-id))))
(if pkg-desc
- (describe-package pkg-desc)
+ (describe-package pkg-desc)
(user-error "No package here"))))
;; fixme numeric argument
(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" "unsigned"))
+ (if (member (package-menu-get-status)
+ '("installed" "dependency" "obsolete" "unsigned"))
(tabulated-list-put-tag "D" t)
(forward-line)))
(defun package-menu-mark-install (&optional _num)
"Mark a package for installation and move to the next line."
(interactive "p")
- (if (member (package-menu-get-status) '("available" "new"))
+ (if (member (package-menu-get-status) '("available" "new" "dependency"))
(tabulated-list-put-tag "I" t)
(forward-line)))
(goto-char (point-min))
(while (not (eobp))
(if (equal (package-menu-get-status) "obsolete")
- (tabulated-list-put-tag "D" t)
- (forward-line 1)))))
+ (tabulated-list-put-tag "D" t)
+ (forward-line 1)))))
(defun package-menu-quick-help ()
"Show short key binding help for package-menu-mode."
(defun package-menu-get-status ()
(let* ((id (tabulated-list-get-id))
- (entry (and id (assq id tabulated-list-entries))))
+ (entry (and id (assq id tabulated-list-entries))))
(if entry
- (aref (cadr entry) 2)
+ (aref (cadr entry) 2)
"")))
+(defun package-archive-priority (archive)
+ "Return the priority of ARCHIVE.
+
+The archive priorities are specified in
+`package-archive-priorities'. If not given there, the priority
+defaults to 0."
+ (or (cdr (assoc archive package-archive-priorities))
+ 0))
+
+(defun package-desc-priority-version (pkg-desc)
+ "Return the version PKG-DESC with the archive priority prepended.
+
+This allows for easy comparison of package versions from
+different archives if archive priorities are meant to be taken in
+consideration."
+ (cons (package-archive-priority
+ (package-desc-archive pkg-desc))
+ (package-desc-version pkg-desc)))
+
(defun package-menu--find-upgrades ()
(let (installed available upgrades)
;; Build list of installed/available packages in this buffer.
(dolist (entry tabulated-list-entries)
;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC])
(let ((pkg-desc (car entry))
- (status (aref (cadr entry) 2)))
- (cond ((member status '("installed" "unsigned"))
+ (status (aref (cadr entry) 2)))
+ (cond ((member status '("installed" "dependency" "unsigned"))
(push pkg-desc installed))
((member status '("available" "new"))
(setq available (package--append-to-alist pkg-desc available))))))
(error "The current buffer is not a Package Menu"))
(let ((upgrades (package-menu--find-upgrades)))
(if (null upgrades)
- (message "No packages to upgrade.")
+ (message "No packages to upgrade.")
(widen)
(save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (let* ((pkg-desc (tabulated-list-get-id))
- (upgrade (cdr (assq (package-desc-name pkg-desc) upgrades))))
- (cond ((null upgrade)
- (forward-line 1))
- ((equal pkg-desc upgrade)
- (package-menu-mark-install))
- (t
- (package-menu-mark-delete))))))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((pkg-desc (tabulated-list-get-id))
+ (upgrade (cdr (assq (package-desc-name pkg-desc) upgrades))))
+ (cond ((null upgrade)
+ (forward-line 1))
+ ((equal pkg-desc upgrade)
+ (package-menu-mark-install))
+ (t
+ (package-menu-mark-delete))))))
(message "%d package%s marked for upgrading."
- (length upgrades)
- (if (= (length upgrades) 1) "" "s")))))
+ (length upgrades)
+ (if (= (length upgrades) 1) "" "s")))))
(defun package-menu-execute (&optional noquery)
"Perform marked Package Menu actions.
(save-excursion
(goto-char (point-min))
(while (not (eobp))
- (setq cmd (char-after))
- (unless (eq cmd ?\s)
- ;; This is the key PKG-DESC.
- (setq pkg-desc (tabulated-list-get-id))
- (cond ((eq cmd ?D)
- (push pkg-desc delete-list))
- ((eq cmd ?I)
- (push pkg-desc install-list))))
- (forward-line)))
+ (setq cmd (char-after))
+ (unless (eq cmd ?\s)
+ ;; This is the key PKG-DESC.
+ (setq pkg-desc (tabulated-list-get-id))
+ (cond ((eq cmd ?D)
+ (push pkg-desc delete-list))
+ ((eq cmd ?I)
+ (push pkg-desc install-list))))
+ (forward-line)))
(when install-list
(if (or
noquery
(length install-list)
(mapconcat #'package-desc-full-name
install-list ", ")))))
- (mapc 'package-install install-list)))
+ (mapc (lambda (p)
+ ;; Don't mark as selected if it's a new version of
+ ;; an installed package.
+ (package-install p (and (not (package-installed-p p))
+ (package-installed-p
+ (package-desc-name p)))))
+ install-list)))
;; Delete packages, prompting if necessary.
(when delete-list
(if (or
noquery
(yes-or-no-p
- (if (= (length delete-list) 1)
- (format "Delete package `%s'? "
+ (if (= (length delete-list) 1)
+ (format "Delete package `%s'? "
(package-desc-full-name (car delete-list)))
- (format "Delete these %d packages (%s)? "
- (length delete-list)
- (mapconcat #'package-desc-full-name
- delete-list ", ")))))
- (dolist (elt delete-list)
- (condition-case-unless-debug err
- (package-delete elt)
- (error (message (cadr err)))))
- (error "Aborted")))
- (if (or delete-list install-list)
- (package-menu--generate t t)
- (message "No operations specified."))))
+ (format "Delete these %d packages (%s)? "
+ (length delete-list)
+ (mapconcat #'package-desc-full-name
+ delete-list ", ")))))
+ (dolist (elt (package--sort-by-dependence delete-list))
+ (condition-case-unless-debug err
+ (package-delete elt)
+ (error (message (cadr err)))))
+ (error "Aborted")))
+ (if (not (or delete-list install-list))
+ (message "No operations specified.")
+ (when package-selected-packages
+ (let ((removable (package--removable-packages)))
+ (when (and removable
+ (y-or-n-p
+ (format "These %d packages are no longer needed, delete them (%s)? "
+ (length removable)
+ (mapconcat #'symbol-name removable ", "))))
+ ;; We know these are removable, so we can use force instead of sorting them.
+ (mapc (lambda (p) (package-delete (cadr (assq p package-alist)) 'force 'nosave))
+ removable))))
+ (package-menu--generate t t))))
(defun package-menu--version-predicate (A B)
(let ((vA (or (aref (cadr A) 1) '(0)))
- (vB (or (aref (cadr B) 1) '(0))))
+ (vB (or (aref (cadr B) 1) '(0))))
(if (version-list-= vA vB)
- (package-menu--name-predicate A B)
+ (package-menu--name-predicate A B)
(version-list-< vA vB))))
(defun package-menu--status-predicate (A B)
(let ((sA (aref (cadr A) 2))
- (sB (aref (cadr B) 2)))
+ (sB (aref (cadr B) 2)))
(cond ((string= sA sB)
- (package-menu--name-predicate A B))
- ((string= sA "new") t)
- ((string= sB "new") nil)
- ((string= sA "available") t)
- ((string= sB "available") nil)
- ((string= sA "installed") t)
- ((string= sB "installed") nil)
- ((string= sA "unsigned") t)
- ((string= sB "unsigned") nil)
- ((string= sA "held") t)
- ((string= sB "held") nil)
- ((string= sA "built-in") t)
- ((string= sB "built-in") nil)
- ((string= sA "obsolete") t)
- ((string= sB "obsolete") nil)
- (t (string< sA sB)))))
+ (package-menu--name-predicate A B))
+ ((string= sA "new") t)
+ ((string= sB "new") nil)
+ ((string= sA "available") t)
+ ((string= sB "available") nil)
+ ((string= sA "installed") t)
+ ((string= sB "installed") nil)
+ ((string= sA "dependency") t)
+ ((string= sB "dependency") nil)
+ ((string= sA "unsigned") t)
+ ((string= sB "unsigned") nil)
+ ((string= sA "held") t)
+ ((string= sB "held") nil)
+ ((string= sA "built-in") t)
+ ((string= sB "built-in") nil)
+ ((string= sA "obsolete") t)
+ ((string= sB "obsolete") nil)
+ ((string= sA "incompat") t)
+ ((string= sB "incompat") nil)
+ (t (string< sA sB)))))
(defun package-menu--description-predicate (A B)
(let ((dA (aref (cadr A) 3))
- (dB (aref (cadr B) 3)))
+ (dB (aref (cadr B) 3)))
(if (string= dA dB)
- (package-menu--name-predicate A B)
+ (package-menu--name-predicate A B)
(string< dA dB))))
(defun package-menu--name-predicate (A B)
(string< (symbol-name (package-desc-name (car A)))
- (symbol-name (package-desc-name (car B)))))
+ (symbol-name (package-desc-name (car B)))))
(defun package-menu--archive-predicate (A B)
(string< (or (package-desc-archive (car A)) "")
- (or (package-desc-archive (car B)) "")))
+ (or (package-desc-archive (car B)) "")))
+
+(defvar-local package-menu--old-archive-contents nil
+ "`package-archive-contents' before the latest refresh.")
+
+(defun package-menu--populate-new-package-list ()
+ "Decide which packages are new in `package-archives-contents'.
+Store this list in `package-menu--new-package-list'."
+ ;; Find which packages are new.
+ (when package-menu--old-archive-contents
+ (dolist (elt package-archive-contents)
+ (unless (assq (car elt) package-menu--old-archive-contents)
+ (push (car elt) package-menu--new-package-list)))
+ (setq package-menu--old-archive-contents nil)))
+
+(defun package-menu--find-and-notify-upgrades ()
+ "Notify the user of upgradable packages."
+ (when-let ((upgrades (package-menu--find-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"))))
+
+(defun package-menu--post-refresh ()
+ "Check for new packages, revert the *Packages* buffer, and check for upgrades.
+This function is called after `package-refresh-contents' is done.
+It goes in `package--post-download-archives-hook', so that it
+works with async refresh as well."
+ (package-menu--populate-new-package-list)
+ (let ((buf (get-buffer "*Packages*")))
+ (when (buffer-live-p buf)
+ (with-current-buffer buf
+ (revert-buffer nil 'noconfirm))))
+ (package-menu--find-and-notify-upgrades))
+
+(defcustom package-menu-async t
+ "If non-nil, package-menu will use async operations when possible.
+Currently, only the refreshing of archive contents supports
+asynchronous operations. Package transactions are still done
+synchronously."
+ :type 'boolean
+ :group 'package)
;;;###autoload
(defun list-packages (&optional no-fetch)
;; Initialize the package system if necessary.
(unless package--initialized
(package-initialize t))
- (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"))))))
+ ;; Integrate the package-menu with updating the archives.
+ (add-hook 'package--post-download-archives-hook
+ #'package-menu--post-refresh)
+
+ (unless no-fetch
+ (setq package-menu--old-archive-contents package-archive-contents)
+ (setq package-menu--new-package-list nil)
+ ;; Fetch the remote list of packages.
+ (package-refresh-contents package-menu-async))
+
+ ;; Generate the Package Menu.
+ (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)))
;;;###autoload
(defalias 'package-list-packages 'list-packages)
(or UPAT...) matches if any of the patterns matches.
(and UPAT...) matches if all the patterns match.
'VAL matches if the object is `equal' to VAL
- `QPAT matches if the QPattern QPAT matches.
(pred FUN) matches if FUN applied to the object returns non-nil.
(guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
(let UPAT EXP) matches if EXP matches UPAT.
If a SYMBOL is used twice in the same pattern (i.e. the pattern is
\"non-linear\"), then the second occurrence is turned into an `eq'uality test.
-QPatterns can take the following forms:
- (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr.
- [QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match
- its 0..(n-1)th elements, respectively.
- ,UPAT matches if the UPattern UPAT matches.
- STRING matches if the object is `equal' to STRING.
- ATOM matches if the object is `eq' to ATOM.
-
FUN can take the form
SYMBOL or (lambda ARGS BODY) in which case it's called with one argument.
(F ARG1 .. ARGn) in which case F gets called with an n+1'th argument
and two identical calls can be merged into one.
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))))"
+`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))
+
+Additional patterns can be defined via `pcase-defmacro'.
+Currently, the following patterns are provided this way:"
(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
;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2)
expansion))))
+;; FIXME: Obviously, this will collide with nadvice's use of
+;; function-documentation if we happen to advise `pcase'.
+(put 'pcase 'function-documentation '(pcase--make-docstring))
+(defun pcase--make-docstring ()
+ (let* ((main (documentation (symbol-function 'pcase) 'raw))
+ (ud (help-split-fundoc main 'pcase)))
+ (with-temp-buffer
+ (insert (or (cdr ud) main))
+ (mapatoms
+ (lambda (symbol)
+ (let ((me (get symbol 'pcase-macroexpander)))
+ (when me
+ (insert "\n\n-- ")
+ (let* ((doc (documentation me 'raw)))
+ (setq doc (help-fns--signature symbol doc me
+ (indirect-function me)))
+ (insert "\n" (or doc "Not documented.")))))))
+ (let ((combined-doc (buffer-string)))
+ (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
+
;;;###autoload
(defmacro pcase-exhaustive (exp &rest cases)
"The exhaustive version of `pcase' (which see)."
;; FIXME: Could we add the FILE:LINE data in the error message?
exp (append cases `((,x (error "No clause matching `%S'" ,x)))))))
+;;;###autoload
+(defmacro pcase-lambda (lambda-list &rest body)
+ "Like `lambda' but allow each argument to be a UPattern.
+I.e. accepts the usual &optional and &rest keywords, but every
+formal argument can be any pattern accepted by `pcase' (a mere
+variable name being but a special case of it)."
+ (declare (doc-string 2) (indent defun)
+ (debug ((&rest pcase-UPAT) body)))
+ (let* ((bindings ())
+ (parsed-body (macroexp-parse-body body))
+ (args (mapcar (lambda (pat)
+ (if (symbolp pat)
+ ;; Simple vars and &rest/&optional are just passed
+ ;; through unchanged.
+ pat
+ (let ((arg (make-symbol
+ (format "arg%s" (length bindings)))))
+ (push `(,pat ,arg) bindings)
+ arg)))
+ lambda-list)))
+ `(lambda ,args ,@(car parsed-body)
+ (pcase-let* ,(nreverse bindings) ,@(cdr parsed-body)))))
+
(defun pcase--let* (bindings body)
(cond
((null bindings) (macroexp-progn body))
;;;###autoload
(defmacro pcase-defmacro (name args &rest body)
"Define a pcase UPattern macro."
- (declare (indent 2) (debug (def-name sexp def-body)) (doc-string 3))
- `(put ',name 'pcase-macroexpander
- (lambda ,args ,@body)))
+ (declare (indent 2) (debug defun) (doc-string 3))
+ (let ((fsym (intern (format "%s--pcase-macroexpander" name))))
+ ;; Add the function via `fsym', so that an autoload cookie placed
+ ;; on a pcase-defmacro will cause the macro to be loaded on demand.
+ `(progn
+ (defun ,fsym ,args ,@body)
+ (put ',name 'pcase-macroexpander #',fsym))))
(defun pcase--match (val upat)
"Build a MATCH structure, hoisting all `or's and `and's outside."
(cond ((eq 'pred (car-safe pat)) (cadr pat))
((not (eq 'quote (car-safe pat))) nil)
((consp (cadr pat)) #'consp)
+ ((stringp (cadr pat)) #'stringp)
((vectorp (cadr pat)) #'vectorp)
((byte-code-function-p (cadr pat))
#'byte-code-function-p))))
(t (error "Incorrect MATCH %S" (car matches)))))
(pcase-defmacro \` (qpat)
+ "Backquote-style pcase patterns.
+QPAT can take the following forms:
+ (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr.
+ [QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match
+ its 0..(n-1)th elements, respectively.
+ ,UPAT matches if the UPattern UPAT matches.
+ STRING matches if the object is `equal' to STRING.
+ ATOM matches if the object is `eq' to ATOM."
(cond
((eq (car-safe qpat) '\,) (cadr qpat))
((vectorp qpat)
;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
-;; Author: Nicolas Petton <petton.nicolas@gmail.com>
+;; Author: Nicolas Petton <nicolas@petton.fr>
;; Keywords: sequences
-;; Version: 1.0
+;; Version: 1.3
+;; Package: seq
;; Maintainer: emacs-devel@gnu.org
;;
;; All provided functions work on lists, strings and vectors.
;;
-;; Functions taking a predicate or a function iterating over the
-;; sequence as argument take the function as their first argument and
+;; Functions taking a predicate or iterating over a sequence using a
+;; function as argument take the function as their first argument and
;; the sequence as their second argument. All other functions take
;; the sequence as their first argument.
;;
(seq-subseq seq 0 (min (max n 0) (seq-length seq)))))
(defun seq-drop-while (pred seq)
- "Return a sequence, from the first element for which (PRED element) is nil, of SEQ.
+ "Return a sequence from the first element for which (PRED element) is nil in SEQ.
The result is a sequence of the same type as SEQ."
(if (listp seq)
(seq--drop-while-list pred seq)
(seq-drop seq (seq--count-successive pred seq))))
(defun seq-take-while (pred seq)
- "Return a sequence of the successive elements for which (PRED element) is non-nil in SEQ.
+ "Return the successive elements for which (PRED element) is non-nil in SEQ.
The result is a sequence of the same type as SEQ."
(if (listp seq)
(seq--take-while-list pred seq)
t))
(defun seq-count (pred seq)
- "Return the number of elements for which (PRED element) returns non-nil in seq."
+ "Return the number of elements for which (PRED element) is non-nil in SEQ."
(let ((count 0))
(seq-doseq (elt seq)
(when (funcall pred elt)
(if (listp seq)
(sort (seq-copy seq) pred)
(let ((result (seq-sort pred (append seq nil))))
- (cond ((stringp seq) (concat result))
- ((vectorp seq) (vconcat result))
- (t (error "Unsupported sequence: %s" seq))))))
+ (seq-into result (type-of seq)))))
(defun seq-contains-p (seq elt &optional testfn)
"Return the first element in SEQ that equals to ELT.
(`list (apply #'append (append seqs '(nil))))
(t (error "Not a sequence type name: %s" type))))
+(defun seq-mapcat (function seq &optional type)
+ "Concatenate the result of applying FUNCTION to each element of SEQ.
+The result is a sequence of type TYPE, or a list if TYPE is nil."
+ (apply #'seq-concatenate (or type 'list)
+ (seq-map function seq)))
+
+(defun seq-partition (seq n)
+ "Return a list of the elements of SEQ grouped into sub-sequences of length N.
+The last sequence may contain less than N elements. If N is a
+negative integer or 0, nil is returned."
+ (unless (< n 1)
+ (let ((result '()))
+ (while (not (seq-empty-p seq))
+ (push (seq-take seq n) result)
+ (setq seq (seq-drop seq n)))
+ (nreverse result))))
+
+(defun seq-group-by (function seq)
+ "Apply FUNCTION to each element of SEQ.
+Separate the elements of SEQ into an alist using the results as
+keys. Keys are compared using `equal'."
+ (seq-reduce
+ (lambda (acc elt)
+ (let* ((key (funcall function elt))
+ (cell (assoc key acc)))
+ (if cell
+ (setcdr cell (push elt (cdr cell)))
+ (push (list key elt) acc))
+ acc))
+ (seq-reverse seq)
+ nil))
+
+(defalias 'seq-reverse
+ (if (ignore-errors (reverse [1 2]))
+ #'reverse
+ (lambda (seq)
+ "Return the reversed copy of list, vector, or string SEQ.
+See also the function `nreverse', which is used more often."
+ (let ((result '()))
+ (seq-map (lambda (elt) (push elt result))
+ seq)
+ (if (listp seq)
+ result
+ (seq-into result (type-of seq)))))))
+
+(defun seq-into (seq type)
+ "Convert the sequence SEQ into a sequence of type TYPE.
+TYPE can be one of the following symbols: vector, string or list."
+ (pcase type
+ (`vector (vconcat seq))
+ (`string (concat seq))
+ (`list (append seq nil))
+ (t (error "Not a sequence type name: %s" type))))
+
(defun seq--drop-list (list n)
- "Optimized version of `seq-drop' for lists."
+ "Return a list from LIST without its first N elements.
+This is an optimization for lists in `seq-drop'."
(while (and list (> n 0))
(setq list (cdr list)
n (1- n)))
list)
(defun seq--take-list (list n)
- "Optimized version of `seq-take' for lists."
+ "Return a list from LIST made of its first N elements.
+This is an optimization for lists in `seq-take'."
(let ((result '()))
(while (and list (> n 0))
(setq n (1- n))
(nreverse result)))
(defun seq--drop-while-list (pred list)
- "Optimized version of `seq-drop-while' for lists."
+ "Return a list from the first element for which (PRED element) is nil in LIST.
+This is an optimization for lists in `seq-drop-while'."
(while (and list (funcall pred (car list)))
(setq list (cdr list)))
list)
(defun seq--take-while-list (pred list)
- "Optimized version of `seq-take-while' for lists."
+ "Return the successive elements for which (PRED element) is non-nil in LIST.
+This is an optimization for lists in `seq-take-while'."
(let ((result '()))
(while (and list (funcall pred (car list)))
(push (pop list) result))
(defalias 'seq-copy #'copy-sequence)
(defalias 'seq-elt #'elt)
-(defalias 'seq-reverse #'reverse)
(defalias 'seq-length #'length)
(defalias 'seq-do #'mapc)
(defalias 'seq-each #'seq-do)
(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)))))
+ ;; `cons' can be nil for openers/closers which only contain
+ ;; "atomic" elements.
+ (when cons
+ (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)))
;; (smie-check-grammar table prec2 'step3)
;;; Miscellaneous commands using the precedence parser.
-(defun smie-backward-sexp-command (&optional n)
+(defun smie-backward-sexp-command (n)
"Move backward through N logical elements."
(interactive "^p")
(smie-forward-sexp-command (- n)))
-(defun smie-forward-sexp-command (&optional n)
+(defun smie-forward-sexp-command (n)
"Move forward through N logical elements."
(interactive "^p")
(let ((forw (> n 0))
+++ /dev/null
-* Emacs Parallel
-
- Emacs Parallel is yet another library to simulate parallel
- computations in Emacs (because it lacks threads support in Elisp).
-
-* STARTED HowTo
-
- You can execute a simple function a retrive the result like this:
- #+BEGIN_SRC emacs-lisp
- (parallel-get-result (parallel-start (lambda () (* 42 42))))
- ⇒ 1764
- #+END_SRC
-
- Though you won't benefit from the parallelism because
- ~parallel-get-result~ is blocking, that is it waits for the function
- to be executed.
-
- So you can use define a callback to be called when the function is
- finished:
- #+BEGIN_SRC emacs-lisp
- (parallel-start (lambda () (sleep-for 4.2) "Hello World")
- :post-exec (lambda (results _status)
- (message (first results))))
- ⊣ Hello World
- #+END_SRC
-
- Here, why ~(first results)~ and not ~result~? Because you can send
- data from the remote instance while it's running with
- ~parallel-remote-send~:
- #+BEGIN_SRC emacs-lisp
- (parallel-start (lambda ()
- (parallel-remote-send "Hello")
- (sleep-for 4.2)
- "World")
- :post-exec (lambda (results _status)
- (message "%s"
- (mapconcat #'identity (reverse results) " "))))
- ⊣ Hello World
- #+END_SRC
- As you may have noticed the results are pushed in a list, so the
- first element is the result returned by the function called, the
- second is the last piece of data send, and so on...
-
- And of course you can execute some code when you receive data from
- the remote instance:
- #+BEGIN_SRC emacs-lisp
- (parallel-start (lambda ()
- (parallel-remote-send 42)
- (sleep-for 4.2) ; heavy computation to compute PI
- pi)
- :on-event (lambda (data)
- (message "Received %S" data)))
- ⊣ Received 42
- ⊣ Received 3.141592653589793
- #+END_SRC
-
- Because the function is executed in another Emacs instance (in Batch
- Mode by default), the environment isn't the same. However you can
- send some data with the ~env~ parameter:
- #+BEGIN_SRC emacs-lisp
- (let ((a 42)
- (b 12))
- (parallel-get-result (parallel-start (lambda (a b) (+ a b))
- :env (list a b))))
- ⇒ 54
- #+END_SRC
-
- By default, the remote Emacs instance is exited when the function is
- executed, but you can keep it running with the
- ~:continue-when-executed~ option and send new code to be executed
- with ~parellel-send~.
- #+BEGIN_SRC emacs-lisp
- (let ((task (parallel-start (lambda () 42)
- :continue-when-executed t)))
- (sleep-for 4.2)
- (parallel-send task (lambda () (setq parallel-continue-when-executed nil) 12))
- (parallel-get-results task))
- ⇒ (12 42)
- #+END_SRC
-
- As you can see, to stop the remote instance you have to set the
- variable ~parallel-continue-when-executed~ to nil.
-
-* Modules
-
-** Parallel XWidget
-
- [[http://www.emacswiki.org/emacs/EmacsXWidgets][Emacs XWidget]] is an experimental branch which permits to embed GTK+
- widget inside Emacs buffers. For instance, it is possible to use it
- to render an HTML page using the webkit engine within an Emacs
- buffer.
-
- With this module, you can configure your "main" Emacs to use
- another one to render web pages.
-
- Let's assume that you've cloned [[https://github.com/jave/xwidget-emacs][the Emacs XWidget repository]] in
- ~$HOME/src/emacs-xwidget/~. Once you've compiled it, an Emacs
- executable is available ~$HOME/src/emacs-xwidget/src/emacs~.
-
- Configure ~parallel-xwidget~ to use it:
- #+BEGIN_SRC emacs-lisp
- (setq parallel-xwidget-config (list :emacs-path
- (concat (getenv "HOME")
- "/src/emacs-xwidget/src/emacs")))
- #+END_SRC
-
- Then configure your current Emacs to use it:
- #+BEGIN_SRC emacs-lisp
- (setq browse-url-browser-function 'parallel-xwidget-browse-url)
- #+END_SRC
-
- You can check it out with M-x browse-url RET google.com RET.
-
-* Tips & Tricks
-
- If your windows manager is smart enough (like StumpwWM) you can use
- it to move graphical windows (Emacs frames) in another desktop.
-
- For example, I use this to move Emacs frames (with the title
- "emacs-debug") to the group (aka desktop) 9:
- #+BEGIN_SRC lisp
- (define-frame-preference "9"
- (0 nil t :title "emacs-debug"))
- #+END_SRC
-
- And this to specify the title of the frame:
- #+BEGIN_SRC emacs-lisp
- (parallel-start (lambda () 42)
- :no-batch t
- :emacs-args '("-T" "emacs-debug"))
- #+END_SRC
-
-* TODO How does it work?
-
-* Known limitations
-
- You can only send data to the remote (with the ~env~ parameter) or
- from the remote (with ~parallel-send~ and ~parallel-remote-send~)
- that have a printed representation (see [[info:elisp#Printed%20Representation][info:elisp#Printed
- Representation]]).
-
- So you can pass around numbers, symbols, strings, lists, vectors,
- hash-table but you can't pass buffers, windows, frames...
-
-
- It lacks documentation, tests and probably a clean API, but I'm
- working on it!
+++ /dev/null
-;; -*- mode: emacs-lisp; lexical-binding: t; -*-
-;;; parallel-remote.el ---
-
-;; Copyright (C) 2013 Grégoire Jadi
-
-;; Author: Grégoire Jadi <gregoire.jadi@gmail.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 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:
-
-(require 'cl)
-
-(defvar parallel-service nil)
-(defvar parallel-task-id nil)
-(defvar parallel-client nil)
-(defvar parallel--executed nil)
-(defvar parallel-continue-when-executed nil)
-
-(defun parallel-remote-send (data)
- (process-send-string parallel-client
- (format "%S " (cons parallel-task-id data))))
-
-(defun parallel-remote--init ()
- (setq parallel-client (make-network-process :name "emacs-parallel"
- :buffer nil
- :server nil
- :service parallel-service
- :host "localhost"
- :family 'ipv4))
- (set-process-filter parallel-client #'parallel-remote--filter)
- (parallel-remote-send 'code)
- (when noninteractive ; Batch Mode
- ;; The evaluation is done in the `parallel--filter' but in Batch
- ;; Mode, Emacs doesn't wait for the input, it stops as soon as
- ;; `parallel--init' has been executed.
- (while (null parallel--executed)
- (sleep-for 10)))) ; arbitrary chosen
-
-(defun parallel-remote--filter (_proc output)
- (dolist (code (parallel--read-output output))
- (parallel-remote-send
- (if (or noninteractive
- (not debug-on-error))
- (condition-case err
- (eval code)
- (error err))
- (eval code))))
- (unless parallel-continue-when-executed
- (setq parallel--executed t)
- (kill-emacs)))
-
-(defun parallel--read-output (output)
- "Read lisp forms from output and return them as a list."
- (loop with output = (replace-regexp-in-string
- "\\`[ \t\n]*" ""
- (replace-regexp-in-string "[ \t\n]*\\'" "" output)) ; trim string
- with start = 0
- with end = (length output)
- for ret = (read-from-string output start end)
- for data = (first ret)
- do (setq start (rest ret))
- collect data
- until (= start end)))
-
-(provide 'parallel-remote)
-
-;;; parallel-remote.el ends here
+++ /dev/null
-;;; parallel-xwidget.el ---
-
-;; Copyright (C) 2013 Grégoire Jadi
-
-;; Author: Grégoire Jadi <gregoire.jadi@gmail.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 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:
-
-(require 'parallel)
-(require 'browse-url)
-
-(defgroup parallel-xwidget nil
- "Browse the web in another emacs instance with XWidget."
- :group 'emacs)
-
-(defvar parallel-xwidget--task nil)
-
-(defcustom parallel-xwidget-config nil
- "Parallel configuration."
- :type 'alist
- :group 'parallel-xwidget)
-
-(defun parallel-xwidget--init ()
- (setq parallel-xwidget--task
- (parallel-start (lambda ()
- (require 'xwidget))
- :graphical t
- :continue-when-executed t
- :config parallel-xwidget-config)))
-
-(defun parallel-xwidget-browse-url (url &optional new-session)
- "Browse URL in another Emacs instance."
- (interactive (browse-url-interactive-arg "xwidget-webkit URL: "))
- (unless (and parallel-xwidget--task
- (eq 'run (parallel-status parallel-xwidget--task)))
- (parallel-xwidget--init))
- (parallel-send parallel-xwidget--task
- (lambda (url new-session)
- (xwidget-webkit-browse-url url new-session))
- (url-tidy url) new-session))
-
-(provide 'parallel-xwidget)
-
-;;; parallel-xwidget.el ends here
+++ /dev/null
-;; -*- lexical-binding: t; -*-
-;;; parallel.el ---
-
-;; Copyright (C) 2013 Grégoire Jadi
-
-;; Author: Grégoire Jadi <gregoire.jadi@gmail.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 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:
-
-(require 'cl)
-(require 'parallel-remote)
-
-(defgroup parallel nil
- "Execute stuff in parallel"
- :group 'emacs)
-
-(defcustom parallel-sleep 0.05
- "How many sec should we wait while polling."
- :type 'number
- :group 'parallel)
-
-(defcustom parallel-config nil
- "Global config setting to use."
- :type 'plist
- :group 'parallel)
-
-(defvar parallel--server nil)
-(defvar parallel--tasks nil)
-(defvar parallel--tunnels nil)
-
-;; Declare external function
-(declare-function parallel-send "parallel-remote")
-
-(defun parallel-make-tunnel (username hostname)
- (parallel--init-server)
- (let ((tunnel (find-if (lambda (tun)
- (and (string= username
- (process-get tun 'username))
- (string= hostname
- (process-get tun 'hostname))))
- parallel--tunnels)))
- (unless tunnel
- (setq tunnel (start-process "parallel-ssh" nil "ssh"
- "-N" "-R" (format "0:localhost:%s"
- (process-contact parallel--server :service))
- (format "%s@%s" username hostname)))
- (process-put tunnel 'username username)
- (process-put tunnel 'hostname hostname)
- (set-process-filter tunnel #'parallel--tunnel-filter)
- (while (null (process-get tunnel 'service))
- (sleep-for 0.01))
- (push tunnel parallel--tunnels))
- tunnel))
-
-(defun parallel-stop-tunnel (tunnel)
- (setq parallel--tunnels (delq tunnel parallel--tunnels))
- (delete-process tunnel))
-
-(defun parallel--tunnel-filter (proc output)
- (if (string-match "\\([0-9]+\\)" output)
- (process-put proc 'service (match-string 1 output))))
-
-(defmacro parallel--set-option (place config)
- `(setf ,place (or ,place
- (plist-get ,config ,(intern (format ":%s" (symbol-name place))))
- (plist-get parallel-config ,(intern (format ":%s" (symbol-name place)))))))
-
-(defmacro parallel--set-options (config &rest options)
- `(progn
- ,@(loop for option in options
- collect `(parallel--set-option ,option ,config))))
-
-(defun* parallel-start (exec-fun &key post-exec env timeout
- emacs-path library-path emacs-args
- graphical debug on-event continue-when-executed
- username hostname hostport
- config)
- (parallel--init-server)
-
- ;; Initialize parameters
- (parallel--set-options config
- post-exec
- env
- timeout
- emacs-args
- graphical
- debug
- on-event
- continue-when-executed
- username
- hostname
- hostport)
-
- (setq emacs-path (or emacs-path
- (plist-get config :emacs-path)
- (plist-get parallel-config :emacs-path)
- (expand-file-name invocation-name
- invocation-directory))
- library-path (or library-path
- (plist-get config :library-path)
- (plist-get parallel-config :library-path)
- (locate-library "parallel-remote")))
-
- (let ((task (parallel--new-task))
- proc tunnel ssh-args)
- (push task parallel--tasks)
- (put task 'initialized nil)
- (put task 'exec-fun exec-fun)
- (put task 'env env)
- (when (functionp post-exec)
- (put task 'post-exec post-exec))
- (when (functionp on-event)
- (put task 'on-event on-event))
- (put task 'results nil)
- (put task 'status 'run)
- (put task 'queue nil)
-
- ;; We need to get the tunnel if it exists so we can send the right
- ;; `service' to the remote.
- (when (and username hostname)
- (if hostport
- (setq ssh-args (list "-R" (format "%s:localhost:%s" hostport
- (process-contact parallel--server :service)))
- tunnel t)
- (setq tunnel (parallel-make-tunnel username hostname)
- hostport (process-get tunnel 'service)))
- (setq ssh-args (append
- ssh-args
- (if graphical (list "-X"))
- (list (format "%s@%s" username hostname)))))
- (setq emacs-args (remq nil
- (list* "-Q" "-l" library-path
- (if graphical nil "-batch")
- "--eval" (format "(setq parallel-service '%S)"
- (if tunnel
- hostport
- (process-contact parallel--server :service)))
- "--eval" (format "(setq parallel-task-id '%S)" task)
- "--eval" (format "(setq debug-on-error '%S)" debug)
- "--eval" (format "(setq parallel-continue-when-executed '%S)" continue-when-executed)
- "-f" "parallel-remote--init"
- emacs-args)))
-
- ;; Reformat emacs-args if we use a tunnel (escape string)
- (when tunnel
- (setq emacs-args (list (mapconcat (lambda (string)
- (if (find ?' string)
- (prin1-to-string string)
- string))
- emacs-args " "))))
- (setq proc (apply #'start-process "parallel" nil
- `(,@(when tunnel
- (list* "ssh" ssh-args))
- ,emacs-path
- ,@emacs-args)))
- (put task 'proc proc)
- (set-process-sentinel (get task 'proc) #'parallel--sentinel)
- (when timeout
- (run-at-time timeout nil (lambda ()
- (when (memq (parallel-status task)
- '(run stop))
- (parallel-stop task)))))
- task))
-
-(defun parallel--new-task ()
- "Generate a new task by enforcing a unique name."
- (let ((symbol-name (make-temp-name "parallel-task-")))
- (while (intern-soft symbol-name)
- (setq symbol-name (make-temp-name "parallel-task-")))
- (intern symbol-name)))
-
-(defun parallel--init-server ()
- "Initialize `parallel--server'."
- (when (or (null parallel--server)
- (not (eq (process-status parallel--server)
- 'listen)))
- (setq parallel--server
- (make-network-process :name "parallel-server"
- :buffer nil
- :server t
- :host "localhost"
- :service t
- :family 'ipv4
- :filter #'parallel--filter
- :filter-multibyte t))))
-
-(defun parallel--get-task-process (proc)
- "Return the task running the given PROC."
- (find-if (lambda (task)
- (eq (get task 'proc) proc))
- parallel--tasks))
-
-(defun parallel--sentinel (proc _event)
- "Sentinel to watch over the remote process.
-
-This function do the necessary cleanup when the remote process is
-finished."
- (when (memq (process-status proc) '(exit signal))
- (let* ((task (parallel--get-task-process proc))
- (results (get task 'results))
- (status (process-status proc)))
- ;; 0 means that the remote process has terminated normally (no
- ;; SIGNUM 0).
- (if (zerop (process-exit-status proc))
- (setq status 'success)
- ;; on failure, push the exit-code or signal number on the
- ;; results stack.
- (push (process-exit-status proc) results))
- (put task 'results results)
- (put task 'status status)
-
- (when (functionp (get task 'post-exec))
- (funcall (get task 'post-exec)
- results status))
- (setq parallel--tasks (delq task parallel--tasks)))))
-
-(defun parallel--call-with-env (fun env)
- "Return a string which can be READ/EVAL by the remote process
-to `funcall' FUN with ENV as arguments."
- (format "(funcall (read %S) %s)"
- (prin1-to-string fun)
- (mapconcat (lambda (obj)
- ;; We need to quote it because the remote
- ;; process will READ/EVAL it.
- (format "'%S" obj)) env " ")))
-
-(defun parallel--filter (connection output)
- "Server filter used to retrieve the results send by the remote
-process and send the code to be executed by it."
- (dolist (data (parallel--read-output output))
- (parallel--process-output connection (first data) (rest data))))
-
-(defun parallel--process-output (connection task result)
- (put task 'connection connection)
- (cond ((and (not (get task 'initialized))
- (eq result 'code))
- (apply #'parallel-send
- task
- (get task 'exec-fun)
- (get task 'env))
- (let ((code nil))
- (while (setq code (pop (get task 'queue)))
- (apply #'parallel-send task (car code) (cdr code))))
- (put task 'initialized t))
- (t
- (push result (get task 'results))
- (if (functionp (get task 'on-event))
- (funcall (get task 'on-event) result)))))
-
-(defun parallel-ready-p (task)
- "Determine whether TASK is finished and if the results are
-available."
- (memq (parallel-status task) '(success exit signal)))
-
-(defun parallel-get-result (task)
- "Return the last result send by the remote call, that is the
-result returned by exec-fun."
- (first (parallel-get-results task)))
-
-(defun parallel-get-results (task)
- "Return all results send during the call of exec-fun."
- (parallel-wait task)
- (get task 'results))
-
-(defun parallel-success-p (task)
- "Determine whether TASK has ended successfully."
- (parallel-wait task)
- (eq (parallel-status task) 'success))
-
-(defun parallel-status (task)
- "Return TASK status."
- (get task 'status))
-
-(defun parallel-wait (task)
- "Wait for TASK."
- (while (not (parallel-ready-p task))
- (sleep-for parallel-sleep))
- t) ; for REPL
-
-(defun parallel-stop (task)
- "Stop TASK."
- (delete-process (get task 'proc)))
-
-(defun parallel-send (task fun &rest env)
- "Send FUN to be evaluated by TASK in ENV."
- (let ((connection (get task 'connection)))
- (if connection
- (process-send-string
- connection
- (parallel--call-with-env fun env))
- (push (cons fun env) (get task 'queue)))))
-
-(provide 'parallel)
-
-;;; parallel.el ends here
(defun viper-ESC (arg)
"Emulate ESC key in Emacs.
Prevents multiple escape keystrokes if viper-no-multiple-ESC is true.
-If viper-no-multiple-ESC is 'twice double ESC would ding in vi-state.
+If `viper-no-multiple-ESC' is `twice' double ESC would ding in vi-state.
Other ESC sequences are emulated via the current Emacs's major mode
keymap. This is more convenient on TTYs, since this won't block
function keys such as up, down, etc. ESC will also will also work as
-a Meta key in this case. When viper-no-multiple-ESC is nil, ESC works
+a Meta key in this case. When `viper-no-multiple-ESC' is nil, ESC works
as a Meta key and any number of multiple escapes are allowed."
(interactive "P")
(let (char)
:type 'boolean
:group 'viper)
-(defcustom viper-read-buffer-function 'read-buffer
+(defcustom viper-read-buffer-function #'read-buffer
"Function to use for prompting the user for a buffer name."
:type 'symbol
:group 'viper)
:group 'viper)
(defcustom viper-no-multiple-ESC t
- "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
+ "If non-nil, 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
don't have a convenient Meta key.
-Setting viper-no-multiple-ESC to nil will allow as many multiple ESC,
-as is allowed by the major mode in effect."
+Setting it to nil will allow as many multiple ESC, as is allowed by the
+major mode in effect."
:type 'boolean
:group 'viper)
(defun epg-start-generate-key (context parameters)
"Initiate a key generation.
-PARAMETERS specifies parameters for the key.
+PARAMETERS is a string which specifies parameters of the generated key.
+See Info node `(gnupg) Unattended GPG key generation' in the
+GnuPG manual for the format.
If you use this function, you will need to wait for the completion of
`epg-gpg-program' by using `epg-wait-for-completion' and call
(setf (epg-context-operation context) 'generate-key)
(setf (epg-context-result context) nil)
(if (epg-data-file parameters)
- (epg--start context (list "--batch" "--genkey" "--"
+ (epg--start context (list "--batch" "--gen-key" "--"
(epg-data-file parameters)))
- (epg--start context '("--batch" "--genkey"))
+ (epg--start context '("--batch" "--gen-key"))
(if (eq (process-status (epg-context-process context)) 'run)
(process-send-string (epg-context-process context)
(epg-data-string parameters)))
+2015-03-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc.el (erc-switch-to-buffer): Fix last change (bug#20187).
+
+2015-03-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc.el (erc-switch-to-buffer): Rename from erc-iswitchb and rewrite
+ using read-buffer (bug#20116).
+ (erc--buffer-p): New function, extracted from erc-buffer-filter.
+ (erc-buffer-filter): Use it.
+ (erc-with-all-buffers-of-server): Silence compile warning if the return
+ value is unused.
+ (erc-is-valid-nick-p, erc-common-server-suffixes, erc-get-arglist)
+ (erc-command-name, erc-popup-input-buffer): Use \` and \' to match
+ beg/end of string.
+
+2015-03-03 Kelvin White <kwhite@gnu.org>
+
+ * erc.el: Add old version string back to file header for
+ package.el compatibility
+
+2015-03-03 Glenn Morris <rgm@gnu.org>
+
+ * erc.el (erc-rename-buffers): Doc fix. Add :version.
+
+2015-03-03 Dima Kogan <dima@secretsauce.net>
+
+ * erc-backend.el (define-erc-response-handler): Give hook-name
+ default value of nil and add-to-list (bug#19363).
+2015-02-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc-spelling.el (erc-spelling-init):
+ Use flyspell-generic-check-word-predicate.
+
2015-01-28 Dima Kogan <dima@secretsauce.net>
* erc-backend.el (define-erc-response-handler): Give hook-name
(if dicts
(cadr (car dicts))
(erc-with-server-buffer ispell-local-dictionary)))))
- (setq flyspell-generic-check-word-p 'erc-spelling-flyspell-verify)
+ (setq flyspell-generic-check-word-predicate #'erc-spelling-flyspell-verify)
(flyspell-mode 1)))
(defun erc-spelling-unhighlight-word (word)
(defun erc-spelling-flyspell-verify ()
"Flyspell only the input line, nothing else."
+ ;; FIXME: Don't use `flyspell-word'!
(let ((word-data (and (boundp 'flyspell-word)
flyspell-word)))
(when word-data
;; Kelvin White (kwhite@gnu.org)
;; Maintainer: emacs-devel@gnu.org
;; Keywords: IRC, chat, client, Internet
-
+;; Version: 5.3
;; This file is part of GNU Emacs.
(set sym (if (functionp val) (funcall val) val))))
(defcustom erc-rename-buffers nil
- "When this is set to t, buffers will be renamed to network name if available"
+ "Non-nil means rename buffers with network name, if available."
+ :version "24.5"
:group 'erc
:type 'boolean)
(define-key map "\C-a" 'erc-bol)
(define-key map [home] 'erc-bol)
(define-key map "\C-c\C-a" 'erc-bol)
- (define-key map "\C-c\C-b" 'erc-iswitchb)
+ (define-key map "\C-c\C-b" 'erc-switch-to-buffer)
(define-key map "\C-c\C-c" 'erc-toggle-interpret-controls)
(define-key map "\C-c\C-d" 'erc-input-action)
(define-key map "\C-c\C-e" 'erc-toggle-ctcp-autoresponse)
"Faces for ERC."
:group 'erc)
+;; FIXME faces should not end in "-face".
(defface erc-default-face '((t))
"ERC default face."
:group 'erc-faces)
(throw 'buffer (current-buffer)))))
proc))))
+(defun erc--buffer-p (buf predicate proc)
+ (with-current-buffer buf
+ (and (derived-mode-p 'erc-mode)
+ (or (not proc)
+ (eq proc erc-server-process))
+ (funcall predicate)
+ buf)))
+
(defun erc-buffer-filter (predicate &optional proc)
"Return a list of `erc-mode' buffers matching certain criteria.
PREDICATE is a function executed with each buffer, if it returns t, that buffer
nil
(mapcar (lambda (buf)
(when (buffer-live-p buf)
- (with-current-buffer buf
- (and (eq major-mode 'erc-mode)
- (or (not proc)
- (eq proc erc-server-process))
- (funcall predicate)
- buf))))
+ (erc--buffer-p buf predicate proc)))
(buffer-list)))))
(defun erc-buffer-list (&optional predicate proc)
,pro))))
;; Silence the byte-compiler by binding the result of mapcar to
;; a variable.
+ (ignore res)
res)))
-;; (iswitchb-mode) will autoload iswitchb.el
-(defvar iswitchb-temp-buflist)
-(declare-function iswitchb-read-buffer "iswitchb"
- (prompt &optional default require-match start matches-set))
-(defvar iswitchb-make-buflist-hook)
-
-(defun erc-iswitchb (&optional arg)
- "Use `iswitchb-read-buffer' to prompt for a ERC buffer to switch to.
+(define-obsolete-function-alias 'erc-iswitchb 'erc-switch-to-buffer "25.1")
+(defun erc-switch-to-buffer (&optional arg)
+ "Prompt for a ERC buffer to switch to.
When invoked with prefix argument, use all erc buffers. Without prefix
ARG, allow only buffers related to same session server.
If `erc-track-mode' is in enabled, put the last element of
-`erc-modified-channels-alist' in front of the buffer list.
-
-Due to some yet unresolved reason, global function `iswitchb-mode'
-needs to be active for this function to work."
+`erc-modified-channels-alist' in front of the buffer list."
(interactive "P")
- (let ((enabled (bound-and-true-p iswitchb-mode)))
- (or enabled (iswitchb-mode 1))
- (unwind-protect
- (let ((iswitchb-make-buflist-hook
- (lambda ()
- (setq iswitchb-temp-buflist
- (mapcar 'buffer-name
- (erc-buffer-list
- nil
- (when arg erc-server-process)))))))
- (switch-to-buffer
- (iswitchb-read-buffer
- "Switch-to: "
- (if (boundp 'erc-modified-channels-alist)
- (buffer-name (caar (last erc-modified-channels-alist)))
- nil)
- t)))
- (or enabled (iswitchb-mode -1)))))
+ (switch-to-buffer
+ (read-buffer "Switch to ERC buffer: "
+ (when (boundp 'erc-modified-channels-alist)
+ (buffer-name (caar (last erc-modified-channels-alist))))
+ t
+ ;; Only allow ERC buffers in the same session.
+ (let ((proc (unless arg erc-server-process)))
+ (lambda (bufname)
+ (let ((buf (if (consp bufname)
+ (cdr bufname) (get-buffer bufname))))
+ (when buf
+ (erc--buffer-p buf (lambda () t) proc)
+ (with-current-buffer buf
+ (and (derived-mode-p 'erc-mode)
+ (or (null proc)
+ (eq proc erc-server-process)))))))))))
(defun erc-channel-list (proc)
"Return a list of channel buffers.
Arguments are the same as for `erc'."
(interactive (erc-select-read-args))
(let ((erc-server-connect-function 'erc-open-tls-stream))
- (apply 'erc r)))
+ (apply #'erc r)))
(defun erc-open-tls-stream (name buffer host port)
"Open an TLS stream to an IRC server.
(defun erc-is-valid-nick-p (nick)
"Check if NICK is a valid IRC nickname."
- (string-match (concat "^" erc-valid-nick-regexp "$") nick))
+ (string-match (concat "\\`" erc-valid-nick-regexp "\\'") nick))
(defun erc-display-line (string &optional buffer)
"Display STRING in the ERC BUFFER.
erc-lurker-threshold-time))))
(defcustom erc-common-server-suffixes
- '(("openprojects.net$" . "OPN")
- ("freenode.net$" . "freenode")
- ("oftc.net$" . "OFTC"))
+ '(("openprojects.net\\'" . "OPN")
+ ("freenode.net\\'" . "freenode")
+ ("oftc.net\\'" . "OFTC"))
"Alist of common server name suffixes.
This variable is used in mode-line display to save screen
real estate. Set it to nil if you want to avoid changing
See also `erc-format-message' and `erc-display-line'."
(let ((string (if (symbolp msg)
- (apply 'erc-format-message msg args)
+ (apply #'erc-format-message msg args)
msg)))
(setq string
(cond
(defun erc-get-arglist (fun)
"Return the argument list of a function without the parens."
(let ((arglist (format "%S" (erc-function-arglist fun))))
- (if (string-match "^(\\(.*\\))$" arglist)
+ (if (string-match "\\`(\\(.*\\))\\'" arglist)
(match-string 1 arglist)
arglist)))
"For CMD being the function name of a ERC command, something like
erc-cmd-FOO, this returns a string /FOO."
(let ((command-name (symbol-name cmd)))
- (if (string-match "^erc-cmd-\\(.*\\)$" command-name)
+ (if (string-match "\\`erc-cmd-\\(.*\\)\\'" command-name)
(concat "/" (match-string 1 command-name))
command-name)))
(erc-display-line
(concat "Available user variables:\n"
(apply
- 'concat
+ #'concat
(mapcar
(lambda (var)
(let ((val (symbol-value var)))
t)))
(erc-server-send (format "MODE %s b" chnl)))))
- (t (let ((bans (mapcar 'cdr erc-channel-banlist)))
+ (t (let ((bans (mapcar #'cdr erc-channel-banlist)))
(when bans
;; Glob the bans into groups of three, and carry out the unban.
;; eg. /mode #foo -bbb a*!*@* b*!*@* c*!*@*
(concat "Set topic of " (erc-default-target) ": ")
(when erc-channel-topic
(let ((ss (split-string erc-channel-topic "\C-o")))
- (cons (apply 'concat (if (cdr ss) (butlast ss) ss))
+ (cons (apply #'concat (if (cdr ss) (butlast ss) ss))
0))))))
(let ((topic-list (split-string topic "\C-o"))) ; strip off the topic setter
(erc-cmd-TOPIC (concat (erc-default-target) " " (car topic-list)))))
(MODE-CHAR ON/OFF ARGUMENT)."
(if (string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*$\\|$\\)" mode-string)
- (let ((chars (mapcar 'char-to-string (match-string 1 mode-string)))
+ (let ((chars (mapcar #'char-to-string (match-string 1 mode-string)))
;; arguments in channel modes
(args-str (match-string 2 mode-string))
(args nil)
(if (> minutes 0)
`("%d minutes, %d seconds" ,minutes ,seconds)
`("%d seconds" ,seconds))))
- output (apply 'format format-args))
+ output (apply #'format format-args))
;; Change all "1 units" to "1 unit".
(while (string-match "\\([^0-9]\\|^\\)1 \\S-+\\(s\\)" output)
(setq output (erc-replace-match-subexpression-in-string
(defun erc-format-channel-modes ()
"Return the current channel's modes."
- (concat (apply 'concat
+ (concat (apply #'concat
"+" erc-channel-modes)
(cond ((and erc-channel-user-limit erc-channel-key)
(if erc-show-channel-key-p
"Mode: "
(mapcar (lambda (e)
(list (symbol-name e)))
- (apropos-internal "-mode$" 'commandp))
+ (apropos-internal "-mode\\'" 'commandp))
nil t))))
(pop-to-buffer (make-indirect-buffer (current-buffer) buffer-name))
(funcall mode)
(error "No format spec for message %s" msg))
(when (functionp entry)
(setq entry (apply entry args)))
- (format-spec entry (apply 'format-spec-make args))))
+ (format-spec entry (apply #'format-spec-make args))))
;;; Various hook functions
(setq nth (eshell-hist-word-reference nth)))
(unless (numberp mth)
(setq mth (eshell-hist-word-reference mth)))
- (cons (mapconcat 'identity (eshell-sublist textargs nth mth) "")
+ (cons (mapconcat 'identity (eshell-sublist textargs nth mth) " ")
end))))
(defun eshell-hist-parse-modifier (hist reference)
(goto-char (point-min))
(let ((modifiers (cdr (eshell-parse-modifiers))))
(dolist (mod modifiers)
- (setq hist (funcall mod hist)))
+ (setq hist (car (funcall mod (list hist)))))
hist))
(delete-region here (point)))))
(function
(lambda (str)
(eshell-stringify
- (car (eshell-parse-argument str))))) lst)))
+ (car (eshell-parse-argument str)))))
+ lst)))
(?L . #'(lambda (lst) (mapcar 'downcase lst)))
(?U . #'(lambda (lst) (mapcar 'upcase lst)))
(?C . #'(lambda (lst) (mapcar 'capitalize lst)))
(defun eshell-parse-modifiers ()
"Parse value modifiers and predicates at point.
-If ALLOW-PREDS is non-nil, predicates will be parsed as well.
Return a cons cell of the form
(PRED-FUNC-LIST . MOD-FUNC-LIST)
-NEW-STRING is STRING minus any modifiers. PRED-FUNC-LIST is a list of
-predicate functions. MOD-FUNC-LIST is a list of result modifier
-functions. PRED-FUNCS take a filename and return t if the test
-succeeds; MOD-FUNCS take any string and preform a modification,
-returning the resultant string."
+PRED-FUNC-LIST is a list of predicate functions. MOD-FUNC-LIST
+is a list of result modifier functions. PRED-FUNCS take a
+filename and return t if the test succeeds; MOD-FUNCS take any
+list of strings and perform a modification, returning the
+resultant list of strings."
(let (negate follow preds mods)
(condition-case nil
(while (not (eobp))
(goto-char (point-max))
(recenter -1))
+(defun eshell/clear ()
+ "Scroll contents of eshell window out of sight, leaving a blank window."
+ (interactive)
+ (let ((number-newlines (count-lines (window-start) (point))))
+ (insert (make-string number-newlines ?\n)))
+ (eshell-send-input))
+
(defun eshell-get-old-input (&optional use-current-region)
"Return the command input on the current line."
(if use-current-region
face
(facemenu-active-faces
(cons face
- (if (listp prev)
+ (if (face-list-p prev)
prev
(list prev)))
;; Specify the selected frame
(not (internal-lisp-face-empty-p face frame)))
+(defun face-list-p (face-or-list)
+ "True if FACE-OR-LIST is a list of faces.
+Return nil if FACE-OR-LIST is a non-nil atom, or a cons cell whose car
+is either 'foreground-color, 'background-color, or a keyword."
+ ;; The logic of merge_face_ref (xfaces.c) is recreated here.
+ (and (listp face-or-list)
+ (not (memq (car face-or-list)
+ '(foreground-color background-color)))
+ (not (keywordp (car face-or-list)))))
+
+
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Setting face attributes from X resources.
(get-char-property (point) 'face))))
(cond ((facep faceprop)
(push faceprop faces))
- ((and (listp faceprop)
- ;; Don't treat an attribute spec as a list of faces.
- (not (keywordp (car faceprop)))
- (not (memq (car faceprop)
- '(foreground-color background-color))))
+ ((face-list-p faceprop)
(dolist (face faceprop)
(if (facep face)
(push face faces))))))
(value (cdr (assq param-name parameters))))
(if value
(set-face-attribute (nth 1 param) frame
- (nth 2 param) value))))
- (frame-can-run-window-configuration-change-hook frame t)))
+ (nth 2 param) value))))))
(defun tty-handle-reverse-video (frame parameters)
"Handle the reverse-video frame parameter for terminal frames."
:group 'ffap
:risky t)
-(defcustom ffap-url-fetcher
- (if (fboundp 'browse-url)
- 'browse-url ; rely on browse-url-browser-function
- 'w3-fetch)
- ;; Remote control references:
- ;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html
- ;; http://home.netscape.com/newsref/std/x-remote.html
+(defcustom ffap-url-fetcher 'browse-url
"A function of one argument, called by ffap to fetch an URL.
-Reasonable choices are `w3-fetch' or a `browse-url-*' function.
For a fancy alternative, get `ffap-url.el'."
- :type '(choice (const w3-fetch)
- (const browse-url) ; in recent versions of browse-url
- (const browse-url-netscape)
- (const browse-url-mosaic)
+ :type '(choice (const browse-url)
function)
:group 'ffap
:risky t)
;; These are also used in buffers containing lines of file names,
;; so the end-of-name is matched with $ rather than \\'.
(list "~$" "\\.o$" "\\.exe$" "\\.a$" "\\.elc$" ",v$" "\\.output$"
- "\\.$" "#$" "\\.class$")
+ "\\.$" "#$" "\\.class$" "/\\.#")
"List of regular expressions used as filters by the file cache.
File names which match these expressions will not be added to the cache.
Note that the functions `file-cache-add-file' and `file-cache-add-file-list'
do not use this variable."
+ :version "25.1" ; added "/\\.#"
:type '(repeat regexp)
:group 'file-cache)
(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))
+ (and (memq system-type '(windows-nt ms-dos cygwin nacl))
(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.
(confirm-nonexistent-file-or-buffer) file-name)
t)))
(unless (run-hook-with-args-until-failure 'kill-buffer-query-functions)
- (error "Aborted"))
+ (user-error "Aborted"))
(and (buffer-modified-p) buffer-file-name
(not (yes-or-no-p "Kill and replace the buffer without saving it? "))
- (error "Aborted"))
+ (user-error "Aborted"))
(let ((obuf (current-buffer))
(ofile buffer-file-name)
(onum buffer-file-number)
(not (y-or-n-p (format "File %s is large (%s), really %s? "
(file-name-nondirectory filename)
(file-size-human-readable size) op-type))))
- (error "Aborted")))
+ (user-error "Aborted")))
(defun warn-maybe-out-of-memory (size)
"Warn if an attempt to open file of SIZE bytes may run out of memory."
(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,
-to Emacs features such as format decoding, character code
+due to Emacs features such as format decoding, character code
conversion, `find-file-hook', automatic uncompression, etc.
This function ensures that none of these modifications will take place."
(not no-query)
(not (y-or-n-p (format "A buffer is visiting %s; proceed? "
filename)))
- (error "Aborted")))
+ (user-error "Aborted")))
(or (equal filename buffer-file-name)
(progn
(and filename (lock-buffer filename))
(listp last-nonmenu-event)
use-dialog-box))
(or (y-or-n-p (format "File `%s' exists; overwrite? " filename))
- (error "Canceled")))
+ (user-error "Canceled")))
(set-visited-file-name filename (not confirm))))
(set-buffer-modified-p t)
;; Make buffer writable if file is writable.
(interactive)
(if (null auto-save-list-file-prefix)
(error "You set `auto-save-list-file-prefix' to disable making session files"))
- (let ((dir (file-name-directory auto-save-list-file-prefix)))
+ (let ((dir (file-name-directory auto-save-list-file-prefix))
+ (nd (file-name-nondirectory auto-save-list-file-prefix)))
(unless (file-directory-p dir)
(make-directory dir t))
(unless (directory-files dir nil
- (concat "\\`" (regexp-quote
- (file-name-nondirectory
- auto-save-list-file-prefix)))
+ (if (string= "" nd)
+ directory-files-no-dot-files-regexp
+ (concat "\\`" (regexp-quote nd)))
t)
(error "No previous sessions to recover")))
(let ((ls-lisp-support-shell-wildcards t))
This is used when turning off Font Lock mode.
This is normally set via `font-lock-defaults'.")
-(defvar font-lock-fontify-region-function 'font-lock-default-fontify-region
+(defvar font-lock-fontify-region-function #'font-lock-default-fontify-region
"Function to use for fontifying a region.
It should take two args, the beginning and end of the region, and an optional
third arg VERBOSE. If VERBOSE is non-nil, the function should print status
-messages. This is normally set via `font-lock-defaults'.")
+messages. This is normally set via `font-lock-defaults'.
+If it fontifies a larger region, it should ideally return a list of the form
+\(jit-lock-bounds BEG . END) indicating the bounds of the region actually
+fontified.")
(defvar font-lock-unfontify-region-function 'font-lock-default-unfontify-region
"Function to use for unfontifying a region.
"List of Font Lock mode related modes that should not be turned on.
Currently, valid mode names are `fast-lock-mode', `jit-lock-mode' and
`lazy-lock-mode'. This is normally set via `font-lock-defaults'.")
+(make-obsolete-variable 'font-lock-inhibit-thing-lock nil "25.1")
(defvar-local font-lock-multiline nil
"Whether font-lock should cater to multiline keywords.
;; Don't fontify eagerly (and don't abort if the buffer is large).
(set (make-local-variable 'font-lock-fontified) t)
;; Use jit-lock.
- (jit-lock-register 'font-lock-fontify-region
+ (jit-lock-register #'font-lock-fontify-region
(not font-lock-keywords-only))
;; Tell jit-lock how we extend the region to refontify.
(add-hook 'jit-lock-after-change-extend-region-functions
(font-lock-fontify-syntactic-keywords-region start end)))
(unless font-lock-keywords-only
(font-lock-fontify-syntactically-region beg end loudly))
- (font-lock-fontify-keywords-region beg end loudly)))))
+ (font-lock-fontify-keywords-region beg end loudly)
+ `(jit-lock-bounds ,beg . ,end)))))
;; The following must be rethought, since keywords can override fontification.
;; ;; Now scan for keywords, but not if we are inside a comment now.
(when (memq 'font-lock-extend-region-wholelines
font-lock-extend-region-functions)
(goto-char beg)
- (setq jit-lock-start (min jit-lock-start (line-beginning-position)))
+ (setq beg (min jit-lock-start (line-beginning-position)))
(goto-char end)
- (setq jit-lock-end
+ (setq end
(max jit-lock-end
- (if (bolp) (point) (line-beginning-position 2))))))))
+ (if (bolp) (point) (line-beginning-position 2)))))
+ (setq jit-lock-start beg
+ jit-lock-end end))))
(defun font-lock-fontify-block (&optional arg)
"Fontify some lines the way `font-lock-fontify-buffer' would.
(put-text-property start next prop value object)
(setq start (text-property-any next end prop nil object)))))
-;; For completeness: this is to `remove-text-properties' as `put-text-property'
-;; is to `add-text-properties', etc.
-;;(defun remove-text-property (start end property &optional object)
-;; "Remove a property from text from START to END.
-;;Argument PROPERTY is the property to remove.
-;;Optional argument OBJECT is the string or buffer containing the text.
-;;Return t if the property was actually removed, nil otherwise."
-;; (remove-text-properties start end (list property) object))
-
-;; For consistency: maybe this should be called `remove-single-property' like
-;; `next-single-property-change' (not `next-single-text-property-change'), etc.
-;;(defun remove-single-text-property (start end prop value &optional object)
-;; "Remove a specific property value from text from START to END.
-;;Arguments PROP and VALUE specify the property and value to remove. The
-;;resulting property values are not equal to VALUE nor lists containing VALUE.
-;;Optional argument OBJECT is the string or buffer containing the text."
-;; (let ((start (text-property-not-all start end prop nil object)) next prev)
-;; (while start
-;; (setq next (next-single-property-change start prop object end)
-;; prev (get-text-property start prop object))
-;; (cond ((and (symbolp prev) (eq value prev))
-;; (remove-text-property start next prop object))
-;; ((and (listp prev) (memq value prev))
-;; (let ((new (delq value prev)))
-;; (cond ((null new)
-;; (remove-text-property start next prop object))
-;; ((= (length new) 1)
-;; (put-text-property start next prop (car new) object))
-;; (t
-;; (put-text-property start next prop new object))))))
-;; (setq start (text-property-not-all next end prop nil object)))))
+(defun font-lock--remove-face-from-text-property (start
+ end
+ prop value &optional object)
+ "Remove a specific property value from text from START to END.
+Arguments PROP and VALUE specify the property and value to remove. The
+resulting property values are not `eq' to VALUE nor lists containing VALUE.
+Optional argument OBJECT is the string or buffer containing the text."
+ (let ((start (text-property-not-all start end prop nil object)) next prev)
+ (while start
+ (setq next (next-single-property-change start prop object end)
+ prev (get-text-property start prop object))
+ (cond ((or (atom prev)
+ (keywordp (car prev))
+ (eq (car prev) 'foreground-color)
+ (eq (car prev) 'background-color))
+ (when (eq value prev)
+ (remove-list-of-text-properties start next (list prop) object)))
+ ((memq value prev) ;Assume prev is not dotted.
+ (let ((new (remq value prev)))
+ (cond ((null new)
+ (remove-list-of-text-properties start next (list prop)
+ object))
+ ((= (length new) 1)
+ (put-text-property start next prop (car new) object))
+ (t
+ (put-text-property start next prop new object))))))
+ (setq start (text-property-not-all next end prop nil object)))))
;;; End of Additional text property functions.
\f
(let ((newparms (frame-parameters))
(frame (selected-frame)))
(tty-handle-reverse-video frame newparms)
+ ;; tty-handle-reverse-video might change the frame's
+ ;; color parameters, and we need to use the updated
+ ;; value below.
+ (setq newparms (frame-parameters))
;; If we changed the background color, we need to update
;; the background-mode parameter, and maybe some faces,
;; too.
(unless (or (assq 'background-mode initial-frame-alist)
(assq 'background-mode default-frame-alist))
(frame-set-background-mode frame))
- (face-set-after-frame-default frame))))))
+ (face-set-after-frame-default frame newparms))))))
;; If the initial frame is still around, apply initial-frame-alist
;; and default-frame-alist to it.
(frame-set-background-mode frame-initial-frame))
(face-set-after-frame-default frame-initial-frame)
(setq newparms (delq new-bg newparms)))
+
+ (when (numberp (car frame-size-history))
+ (setq frame-size-history
+ (cons (1- (car frame-size-history))
+ (cons
+ (list frame-initial-frame
+ "frame-notice-user-settings"
+ nil newparms)
+ (cdr frame-size-history)))))
+
(modify-frame-parameters frame-initial-frame newparms)))))
;; Restore the original buffer.
Return nil if we don't know how to interpret DISPLAY."
;; MS-Windows doesn't know how to create a GUI frame in a -nw session.
(if (and (eq system-type 'windows-nt)
- (null (window-system)))
+ (null (window-system))
+ (not (daemonp)))
nil
(cl-loop for descriptor in display-format-alist
for pattern = (car descriptor)
;; Now make the frame.
(run-hooks 'before-make-frame-hook)
-;; (setq frame-adjust-size-history '(t))
+;; (setq frame-size-history '(1000))
(setq frame
(funcall (gui-method frame-creation-function w) params))
(let ((val (frame-parameter oldframe param)))
(when val (set-frame-parameter frame param val)))))
- (when (eq (car frame-adjust-size-history) t)
- (setq frame-adjust-size-history
- (cons t (cons (list "Frame made")
- (cdr frame-adjust-size-history)))))
+ (when (numberp (car frame-size-history))
+ (setq frame-size-history
+ (cons (1- (car frame-size-history))
+ (cons (list frame "make-frame")
+ (cdr frame-size-history)))))
+ ;; We can run `window-configuration-change-hook' for this frame now.
+ (frame-after-make-frame frame t)
(run-hook-with-args 'after-make-frame-functions frame)
frame))
(modify-frame-parameters (selected-frame)
(list (cons 'background-color color-name)))
(or window-system
- (face-set-after-frame-default (selected-frame))))
+ (face-set-after-frame-default (selected-frame)
+ (list
+ (cons 'background-color color-name)
+ ;; Pass the foreground-color as
+ ;; well, if defined, to avoid
+ ;; losing it when faces are reset
+ ;; to their defaults.
+ (assq 'foreground-color
+ (frame-parameters))))))
(defun set-foreground-color (color-name)
"Set the foreground color of the selected frame to COLOR-NAME.
(modify-frame-parameters (selected-frame)
(list (cons 'foreground-color color-name)))
(or window-system
- (face-set-after-frame-default (selected-frame))))
+ (face-set-after-frame-default (selected-frame)
+ (list
+ (cons 'foreground-color color-name)
+ ;; Pass the background-color as
+ ;; well, if defined, to avoid
+ ;; losing it when faces are reset
+ ;; to their defaults.
+ (assq 'background-color
+ (frame-parameters))))))
(defun set-cursor-color (color-name)
"Set the text cursor color of the selected frame to COLOR-NAME.
(defun blink-cursor-timer-function ()
"Timer function of timer `blink-cursor-timer'."
(internal-show-cursor nil (not (internal-show-cursor-p)))
+ ;; Suspend counting blinks when the w32 menu-bar menu is displayed,
+ ;; since otherwise menu tooltips will behave erratically.
+ (or (and (fboundp 'w32--menu-bar-in-use)
+ (w32--menu-bar-in-use))
+ (setq blink-cursor-blinks-done (1+ blink-cursor-blinks-done)))
;; Each blink is two calls to this function.
- (setq blink-cursor-blinks-done (1+ blink-cursor-blinks-done))
(when (and (> blink-cursor-blinks 0)
(<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
(blink-cursor-suspend)
;; Frame maximization/fullscreen
(defun toggle-frame-maximized ()
- "Toggle maximization state of the selected frame.
-Maximize the selected frame or un-maximize if it is already maximized.
-Respect window manager screen decorations.
-If the frame is in fullscreen mode, don't change its mode,
-just toggle the temporary frame parameter `maximized',
-so the frame will go to the right maximization state
-after disabling fullscreen mode.
+ "Toggle maximization state of selected frame.
+Maximize selected frame or un-maximize if it is already maximized.
+
+If the frame is in fullscreen state, don't change its state, but
+set the frame's `fullscreen-restore' parameter to `maximized', so
+the frame will be maximized after disabling fullscreen state.
Note that with some window managers you may have to set
`frame-resize-pixelwise' to non-nil in order to make a frame
-appear truly maximized.
+appear truly maximized. In addition, you may have to set
+`x-frame-normalize-before-maximize' in order to enable
+transitions from one fullscreen state to another.
See also `toggle-frame-fullscreen'."
(interactive)
- (if (memq (frame-parameter nil 'fullscreen) '(fullscreen fullboth))
- (modify-frame-parameters
- nil
- `((maximized
- . ,(unless (eq (frame-parameter nil 'maximized) 'maximized)
- 'maximized))))
- (modify-frame-parameters
- nil
- `((fullscreen
- . ,(unless (eq (frame-parameter nil 'fullscreen) 'maximized)
- 'maximized))))))
+ (let ((fullscreen (frame-parameter nil 'fullscreen)))
+ (cond
+ ((memq fullscreen '(fullscreen fullboth))
+ (set-frame-parameter nil 'fullscreen-restore 'maximized))
+ ((eq fullscreen 'maximized)
+ (set-frame-parameter nil 'fullscreen nil))
+ (t
+ (set-frame-parameter nil 'fullscreen 'maximized)))))
(defun toggle-frame-fullscreen ()
- "Toggle fullscreen mode of the selected frame.
-Enable fullscreen mode of the selected frame or disable if it is
-already fullscreen. Ignore window manager screen decorations.
-When turning on fullscreen mode, remember the previous value of the
-maximization state in the temporary frame parameter `maximized'.
-Restore the maximization state when turning off fullscreen mode.
+ "Toggle fullscreen state of selected frame.
+Make selected frame fullscreen or restore its previous size if it
+is already fullscreen.
+
+Before making the frame fullscreen remember the current value of
+the frame's `fullscreen' parameter in the `fullscreen-restore'
+parameter of the frame. That value is used to restore the
+frame's fullscreen state when toggling fullscreen the next time.
Note that with some window managers you may have to set
`frame-resize-pixelwise' to non-nil in order to make a frame
-appear truly fullscreen.
+appear truly fullscreen. In addition, you may have to set
+`x-frame-normalize-before-maximize' in order to enable
+transitions from one fullscreen state to another.
See also `toggle-frame-maximized'."
(interactive)
- (modify-frame-parameters
- nil
- `((maximized
- . ,(unless (memq (frame-parameter nil 'fullscreen) '(fullscreen fullboth))
- (frame-parameter nil 'fullscreen)))
- (fullscreen
- . ,(if (memq (frame-parameter nil 'fullscreen) '(fullscreen fullboth))
- (if (eq (frame-parameter nil 'maximized) 'maximized)
- 'maximized)
- 'fullscreen)))))
-
+ (let ((fullscreen (frame-parameter nil 'fullscreen)))
+ (if (memq fullscreen '(fullscreen fullboth))
+ (let ((fullscreen-restore (frame-parameter nil 'fullscreen-restore)))
+ (if (memq fullscreen-restore '(maximized fullheight fullwidth))
+ (set-frame-parameter nil 'fullscreen fullscreen-restore)
+ (set-frame-parameter nil 'fullscreen nil)))
+ (modify-frame-parameters
+ nil `((fullscreen . fullboth) (fullscreen-restore . ,fullscreen))))))
\f
;;;; Key bindings
(defun frameset-keep-original-display-p (force-display)
"True if saved frames' displays should be honored.
For the meaning of FORCE-DISPLAY, see `frameset-restore'."
- (cond ((daemonp) t)
- ((eq system-type 'windows-nt) nil) ;; Does ns support more than one display?
+ (cond ((eq system-type 'windows-nt) nil) ;; Does ns support more than one display?
+ ((daemonp) t)
(t (not force-display))))
(defun frameset-minibufferless-first-p (frame1 _frame2)
+2015-04-03 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-browse-html-save-cid-content):
+ Always return relative file name.
+ (gnus-article-browse-html-parts):
+ Make external links absolute and cid file names relative.
+
+2015-04-01 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * registry.el (registry-prune): Re-use `registry-full' in
+ `registry-prune'. It's a bit of redundant work, but safer.
+ Also ensure that target-size is an integer.
+
+2015-03-31 Daiki Ueno <ueno@gnu.org>
+
+ * plstore.el (plstore--decrypt): Clear entry in
+ `plstore-passphrase-alist' if decryption failed (bug#20030).
+
+2015-03-28 Adam Sjøgren <asjo@koldfront.dk>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Add "Display HTML images"
+ to "Display" menu.
+
+2015-03-24 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * nnimap.el (nnimap-split-incoming-mail): If a message is already
+ in the group it should be split to, don't re-copy it into the group.
+
+2015-03-23 Ben Bacarisse <ben.lists@bsb.me.uk> (tiny change)
+
+ * nnmh.el (nnmh-request-expire-articles):
+ Work for the case nnmail-expiry-target is an nnmh group (bug#20170).
+
+2015-03-21 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * registry.el (registry-lookup-secondary, registry-full)
+ (registry-prune, registry-collect-prune-candidates):
+ * gnus-registry.el (gnus-registry-load): Use slot names rather than
+ initarg names in `oref' and `oset'.
+
+2015-03-19 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * registry.el (registry-prune): Allow registry to reach full size
+ before pruning.
+
+2015-03-19 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * registry.el (registry-collect-prune-candidates): Fix call to
+ cl-subseq.
+
+2015-03-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * gnus-registry.el (gnus-registry-handle-action)
+ (gnus-registry-post-process-groups): Don't add-to-list on a local var.
+ (gnus-registry-keywords): Make it do something.
+ (gnus-registry-import-eld): Remove unused var `new-entry'.
+ (gnus-registry-action): Remove unused var `to-name'.
+ (gnus-registry-make-db): Prefer `make-instance' to avoid
+ compiler warnings.
+ (gnus-registry-load, gnus-registry-fixup-registry): Avoid `oset'.
+
+ * registry.el (registry-db): Don't oset-default an instance-allocated
+ slot.
+
+2015-03-10 Glenn Morris <rgm@gnu.org>
+
+ * message.el (message-valid-fqdn-regexp): Bump :version for
+ 2014-11-17 change.
+
+2015-03-08 Rasmus Pank Roulund <rasmus@pank.eu>
+
+ * gnus-notifications.el (gnus-notifications-action): Raise window
+ frame.
+ (gnus-notifications-action): Allow mark as read.
+ (gnus-notifications-notify): Show uption to mark as read.
+
+2015-03-08 Adam Sjøgren <asjo@koldfront.dk>
+
+ * message.el (message-insert-formatted-citation-line): Change %F to
+ fall back to email address if no first name could be determined.
+
+2015-03-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * registry.el (registry-lookup-breaks-before-lexbind, registry-lookup)
+ (registry-search, registry-delete, registry-size, registry-insert)
+ (registry-reindex, registry-collect-prune-candidates):
+ * gnus-registry.el (gnus-registry-fixup-registry)
+ (gnus-registry-remove-extra-data): Use slot names rather than initarg
+ names in `oref' and `oset'.
+
+2015-02-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-mime-inline-part, gnus-mm-display-part):
+ Fix point motion when removing displayed MIME part.
+ (gnus-article-edit-part): Make jumping to the next part really work
+ when deleting or stripping.
+ (gnus-mime-buttonize-attachments-in-header): Make header attachment
+ buttons identical to the ones in the article body so as to work deleting
+ and stripping.
+
+2015-02-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-shr)
+ * mm-view.el (mm-inline-text-html-render-with-w3m):
+ Revert my bogus change that made the start marker of a part
+ the "moves after insertion" type.
+
+2015-02-23 Tassilo Horn <tsdh@gnu.org>
+
+ * mailcap.el (mailcap-mime-data): Support `pdf-view-mode' (from PDF
+ Tools: https://github.com/politza/pdf-tools) for viewing PDF
+ attachments in emacs.
+
+2015-02-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-mime-display-single): Avoid "End of buffer" error.
+
+2015-02-18 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * nnimap.el (nnimap-get-groups): Correctly read unquoted group names
+ from the server LIST response.
+
+2015-02-14 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-retrieve-headers): If the server closes connection
+ during header retrieval, error out instead of interpreting the data in
+ the buffer as the only messages there. This way, we don't mark
+ articles as read on a server hangup (bug#19035).
+
+ * mm-decode.el (mm-head-p): New function.
+ (mm-display-part): Go to a blank line when inserting parts internally.
+
+2015-02-13 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-msg-mail): Don't let-bind `gnus-newsgroup-name' so
+ that we don't get a warning when setting the buffer-local variable
+ (bug#19573).
+
+ * nnmail.el (nnmail-expiry-target-group): Supply the info structure to
+ `gnus-request-group'.
+
+2015-02-12 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-browse-html-save-cid-content)
+ (gnus-article-browse-html-parts): Make cid file names relative if and
+ only if html doesn't specify <base> directory.
+
+2015-02-11 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-treat-buttonize): Don't re-buttonize URLs in HTML
+ parts, because that breaks filling (since buttons are in a bold face).
+
+2015-02-10 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-convert-shr-links): Delete useless variable `face';
+ use gnus-overlays-at and gnus-overlay-put.
+
+2015-02-10 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-shr): Only pass the fill column when not using
+ fonts, because limiting the width to what's appropriate for followups
+ doesn't really help when not using proportional fonts.
+
+2015-02-09 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-convert-shr-links): Don't overwrite the faces from
+ shr, beacause that breaks folding.
+ (mm-shr): Don't shorten the width when using fonts.
+
+2015-02-05 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-start.el (gnus-save-newsrc-file-check-timestamp): Remove
+ variable; always check the newrc timestamp.
+ (gnus-save-newsrc-file): Always check timestamp.
+
+2015-02-05 Timo Lilja <timo.lilja@iki.fi> (tiny change)
+
+ * mail-source.el (mail-source-call-script): If scripts exit with an
+ error, pop up an error buffer.
+
+2015-02-05 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-extra-headers): Add the popular Gmail X-GM-LABELS
+ as a default.
+
+ * nnimap.el (nnimap-request-group-scan): Ensure that we've selected the
+ correct server.
+
+2015-02-05 Vincent Bernat <bernat@luffy.cx> (tiny change)
+
+ * nnimap.el (nnimap-request-group-scan): Fix the function name.
+
+ * gnus-int.el (gnus-request-group-scan): Use the correct function name.
+
+2015-02-05 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-select-newsgroup): Pass the group info along so
+ that nnimap works for non-activated backends.
+
+2015-02-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mm-util.el (mm-with-unibyte-current-buffer): Don't emit a warning
+ message, since we already get an obsolescence message. Use `declare'.
+
+2015-02-04 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * nnir.el: Revert "Enable non-ASCII IMAP searches".
+
2015-01-30 Glenn Morris <rgm@gnu.org>
* gnus-registry.el (gnus-registry-max-pruned-entries)
2014-01-30 Lars Ingebrigtsen <larsi@gnus.org>
* nnmail.el (nnmail-split-it): Instead of redoing the search to restore
- the match data, just save and restore it explictly (bug#12375).
+ the match data, just save and restore it explicitly (bug#12375).
* gnus-sum.el (gnus-summary-read-group-1): Initialize the spam code if
that's needed.
(spam-ham-copy-or-move-routine): Return the number of processed
ham messages.
(spam-summary-prepare-exit): Use the above values to decide
- whether status messages shouled be displayed.
+ whether status messages should be displayed.
2004-05-20 Katsumi Yamaoka <yamaoka@jpl.org>
(autoload 'ansi-color-apply-on-region "ansi-color")
(autoload 'mm-url-insert-file-contents-external "mm-url")
(autoload 'mm-extern-cache-contents "mm-extern")
+(autoload 'url-expand-file-name "url-expand")
(defgroup gnus-article nil
"Article display."
:type gnus-article-treat-custom)
(put 'gnus-treat-highlight-signature 'highlight t)
-(defcustom gnus-treat-buttonize 100000
+(defcustom gnus-treat-buttonize '(and 100000 (typep "text/plain"))
"Add buttons.
Valid values are nil, t, `head', `first', `last', an integer or a
predicate. See Info node `(gnus)Customizing Articles'."
(defun gnus-article-browse-html-save-cid-content (cid handles directory)
"Find CID content in HANDLES and save it in a file in DIRECTORY.
-Return file name."
+Return file name relative to the parent of DIRECTORY."
(save-match-data
- (let (file)
+ (let (file afile)
(catch 'found
(dolist (handle handles)
(cond
cid handle directory))
(throw 'found file)))
((equal (concat "<" cid ">") (mm-handle-id handle))
- (setq file
- (expand-file-name
- (or (mm-handle-filename handle)
- (concat
- (make-temp-name "cid")
- (car (rassoc (car (mm-handle-type handle))
- mailcap-mime-extensions))))
- directory))
- (mm-save-part-to-file handle file)
- (throw 'found file))))))))
+ (setq file (or (mm-handle-filename handle)
+ (concat
+ (make-temp-name "cid")
+ (car (rassoc (car (mm-handle-type handle))
+ mailcap-mime-extensions))))
+ afile (expand-file-name file directory))
+ (mm-save-part-to-file handle afile)
+ (throw 'found (concat (file-name-nondirectory
+ (directory-file-name directory))
+ "/" file)))))))))
(defun gnus-article-browse-html-parts (list &optional header)
"View all \"text/html\" parts from LIST.
(insert content)
;; resolve cid contents
(let ((case-fold-search t)
- cid-file)
+ st base regexp cid-file)
(goto-char (point-min))
+ (when (and (re-search-forward "<head[\t\n >]" nil t)
+ (progn
+ (setq st (match-end 0))
+ (re-search-forward "</head[\t\n >]" nil t))
+ (re-search-backward "<base\
+\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+href=\"\\([^\"]+\\)\"[^>]*>" st t))
+ (setq base (match-string 1))
+ (replace-match "<!--\\&-->")
+ (setq st (point))
+ (dolist (tag '(("a" . "href") ("form" . "action")
+ ("img" . "src")))
+ (setq regexp (concat "<" (car tag)
+ "\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+"
+ (cdr tag) "=\"\\([^\"]+\\)"))
+ (while (re-search-forward regexp nil t)
+ (insert (prog1
+ (condition-case nil
+ (save-match-data
+ (url-expand-file-name (match-string 1)
+ base))
+ (error (match-string 1)))
+ (delete-region (match-beginning 1)
+ (match-end 1)))))
+ (goto-char st)))
(while (re-search-forward "\
<img[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*src=\"\\(cid:\\([^\"]+\\)\\)\""
nil t)
(with-current-buffer gnus-article-buffer
gnus-article-mime-handles)
cid-dir))
- (when (eq system-type 'cygwin)
- (setq cid-file
- (concat "/" (substring
- (with-output-to-string
- (call-process "cygpath" nil
- standard-output
- nil "-m" cid-file))
- 0 -1))))
- (replace-match (concat "file://" cid-file)
- nil nil nil 1))))
+ (replace-match cid-file nil nil nil 1))))
(unless content (setq content (buffer-string))))
(when (or charset header (not file))
(setq tmp-file (mm-make-temp-file
(let ((gnus-mime-buttonized-part-id current-id))
(gnus-article-edit-done))
(gnus-configure-windows 'article)
+ (sit-for 0)
(when (and current-id (integerp gnus-auto-select-part))
(gnus-article-jump-to-part
(min (max (+ current-id gnus-auto-select-part) 1)
'gnus-data))))
(setq b btn))
(if (and (not arg) (mm-handle-undisplayer handle))
- (mm-remove-part handle)
+ (progn
+ (setq b (copy-marker b)
+ btn (copy-marker btn))
+ (mm-remove-part handle))
(cond
((not arg) nil)
((numberp arg)
(forward-line 1))
(mm-display-inline handle))
;; Toggle the button appearance between `[button]...' and `[button]'.
+ (when (markerp btn)
+ (setq btn (prog1 (marker-position btn)
+ (set-marker btn nil))))
(goto-char btn)
(let ((displayed-p (mm-handle-displayed-p handle)))
(gnus-insert-mime-button handle (get-text-property btn 'gnus-part)
'((gnus-treat-highlight-headers
gnus-article-highlight-headers))))
(gnus-treat-article 'head)))))
+ (when (markerp b)
+ (setq b (prog1 (marker-position b)
+ (set-marker b nil))))
(goto-char b))))
(defun gnus-mime-set-charset-parameters (handle charset)
(gnus-mime-view-part-as-type
nil (lambda (type) (mm-inlinable-p handle type)))
(when handle
- (gnus-bind-safe-url-regexp (mm-display-part handle))))))
+ (gnus-bind-safe-url-regexp
+ (mm-display-part handle nil t))))))
(defun gnus-mime-action-on-part (&optional action)
"Do something with the MIME attachment at \(point\)."
point (previous-single-property-change start 'gnus-data))
(if (mm-handle-displayed-p handle)
;; This will remove the part.
- (setq retval (mm-display-part handle))
+ (setq point (copy-marker point)
+ retval (mm-display-part handle))
(let ((part (or (and (mm-inlinable-p handle)
(mm-inlined-p handle)
t)
,(point-max-marker)))))))
(part
(mm-display-inline handle))))))
+ (when (markerp point)
+ (setq point (prog1 (marker-position point)
+ (set-marker point nil))))
(goto-char point)
;; Toggle the button appearance between `[button]...' and `[button]'.
(let ((displayed-p (mm-handle-displayed-p handle)))
(gnus-article-insert-newline)
(if (prog1
(= (skip-chars-backward "\n") -1)
- (forward-char 1))
+ (unless (eobp) (forward-char 1)))
(gnus-article-insert-newline)
(put-text-property (point) (point-max) 'gnus-undeletable t))
(goto-char (point-max)))
(dolist (button (nreverse buttons))
(setq st (point))
(insert " ")
- (mm-handle-set-undisplayer
- (setq handle (copy-sequence (cdr button))) nil)
+ (mm-handle-set-undisplayer (setq handle (cdr button)) nil)
(gnus-insert-mime-button handle (car button))
(skip-chars-backward "\t\n ")
(delete-region (point) (point-max))
(set-buffer buf))))))
(defun gnus-block-private-groups (group)
+ "Allows images in newsgroups to be shown, blocks images in all
+other groups."
(if (or (gnus-news-group-p group)
(gnus-member-of-valid 'global group))
;; Block nothing in news groups.
(defun gnus-request-group-scan (group info)
"Request that GROUP get a complete rescan."
(let ((gnus-command-method (gnus-find-method-for-group group))
- (func 'request-group-description))
+ (func 'request-group-scan))
(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) info))))
nil yank-action send-actions return-action))
(let ((buf (current-buffer))
;; Don't use posting styles corresponding to any existing group.
- (gnus-newsgroup-name "")
+ (group-name gnus-newsgroup-name)
mail-buf)
- (gnus-setup-message 'message
- (message-mail to subject other-headers continue
- nil yank-action send-actions return-action))
+ (unwind-protect
+ (progn
+ (setq gnus-newsgroup-name "")
+ (gnus-setup-message 'message
+ (message-mail to subject other-headers continue
+ nil yank-action send-actions return-action)))
+ (setq gnus-newsgroup-name group-name))
(when switch-action
(setq mail-buf (current-buffer))
(switch-to-buffer buf)
"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)))))))
+ (let ((group-article (assoc id gnus-notifications-id-to-msg)))
+ (when group-article
+ (let ((group (cadr group-article))
+ (article (nth 2 group-article)))
+ (cond ((string= key "read")
+ (gnus-fetch-group group (list article))
+ (gnus-select-frame-set-input-focus (selected-frame)))
+ ((string= key "mark-read")
+ (gnus-update-read-articles
+ group
+ (delq article (gnus-list-of-unread-articles group)))
+ ;; gnus-group-refresh-group
+ (gnus-group-update-group group)))))))
(defun gnus-notifications-notify (from subject photo-file)
"Send a notification about a new mail.
'notifications-notify
:title from
:body subject
- :actions '("read" "Read")
+ :actions '("read" "Read" "mark-read" "Mark As Read")
:on-action 'gnus-notifications-action
:app-icon (gnus-funcall-no-warning
'image-search-load-path "gnus/gnus.png")
(defun gnus-registry-fixup-registry (db)
(when db
- (let ((old (oref db :tracked)))
- (oset db :precious
+ (let ((old (oref db tracked)))
+ (setf (oref db precious)
(append gnus-registry-extra-entries-precious
'()))
- (oset db :max-size
+ (setf (oref db max-size)
(or gnus-registry-max-entries
most-positive-fixnum))
- (oset db :prune-factor
+ (setf (oref db prune-factor)
(or gnus-registry-prune-factor
0.1))
- (oset db :tracked
+ (setf (oref db tracked)
(append gnus-registry-track-extra
'(mark group keyword)))
- (when (not (equal old (oref db :tracked)))
+ (when (not (equal old (oref db tracked)))
(gnus-message 9 "Reindexing the Gnus registry (tracked change)")
(registry-reindex db))))
db)
(defun gnus-registry-make-db (&optional file)
(interactive "fGnus registry persistence file: \n")
(gnus-registry-fixup-registry
- (registry-db
- "Gnus Registry"
- :file (or file gnus-registry-cache-file)
- ;; these parameters are set in `gnus-registry-fixup-registry'
- :max-size most-positive-fixnum
- :version registry-db-version
- :precious nil
- :tracked nil)))
+ (make-instance 'registry-db
+ :file (or file gnus-registry-cache-file)
+ ;; these parameters are set in `gnus-registry-fixup-registry'
+ :max-size most-positive-fixnum
+ :version registry-db-version
+ :precious nil
+ :tracked nil)))
(defvar gnus-registry-db (gnus-registry-make-db)
"The article registry by Message ID. See `registry-db'.")
old-file-name file)))
(progn
(gnus-registry-read old-file-name)
- (oset gnus-registry-db :file file)
+ (setf (oref gnus-registry-db file) file)
(gnus-message 1 "Registry filename changed to %s" file))
(gnus-registry-remake-db t))))
(error
(sender (nth 0 (gnus-registry-extract-addresses
(mail-header-from data-header))))
(from (gnus-group-guess-full-name-from-command-method from))
- (to (if to (gnus-group-guess-full-name-from-command-method to) nil))
- (to-name (if to to "the Bit Bucket")))
+ (to (if to (gnus-group-guess-full-name-from-command-method to) nil)))
(gnus-message 7 "Gnus registry: article %s %s from %s to %s"
id (if method "respooling" "going") from to)
(let ((new (or (assq (first kv) entry)
(list (first kv)))))
(dolist (toadd (cdr kv))
- (add-to-list 'new toadd t))
+ (unless (member toadd new)
+ (setq new (append new (list toadd)))))
(setq entry (cons new
(assq-delete-all (first kv) entry))))))
(gnus-message 10 "Gnus registry: new entry for %s is %S"
10
"%s: stripped group %s to %s"
log-agent group short-name))
- (add-to-list 'out short-name))
+ (pushnew short-name out :test #'equal))
;; else...
(gnus-message
7
(gnus-registry-set-id-key id 'keyword words)))))
(defun gnus-registry-keywords ()
- (let ((table (registry-lookup-secondary gnus-registry-db 'keyword)))
- (when table (maphash (lambda (k v) k) table))))
+ (let ((table (registry-lookup-secondary gnus-registry-db 'keyword))
+ (ks ()))
+ (when table (maphash (lambda (k _v) (push k ks)) table) ks)))
(defun gnus-registry-find-keywords (keyword)
(interactive (list
(setq entry (car-safe old)
old (cdr-safe old))
(let* ((id (car-safe entry))
- (new-entry (gnus-registry-get-or-make-entry id))
(rest (cdr-safe entry))
(groups (loop for p in rest
when (stringp p)
(when extra
(let ((db gnus-registry-db))
(registry-reindex db)
- (loop for k being the hash-keys of (oref db :data)
+ (loop for k being the hash-keys of (oref db data)
using (hash-value v)
do (let ((newv (delq nil (mapcar #'(lambda (entry)
(unless (member (car entry) extra)
:group 'gnus-newsrc
:type 'hook)
-(defcustom gnus-save-newsrc-file-check-timestamp nil
- "Check the modification time of the newsrc.eld file before saving it.
-When the newsrc.eld file is updated by multiple machines,
-checking the file's modification time is a good way to avoid
-overwriting updated data."
- :version "25.1"
- :group 'gnus-newsrc
- :type 'boolean)
-
(defcustom gnus-save-newsrc-hook nil
"A hook called before saving any of the newsrc files."
:group 'gnus-newsrc
;; check timestamp of `gnus-current-startup-file'.eld against
;; `gnus-save-newsrc-file-last-timestamp'
- (when gnus-save-newsrc-file-check-timestamp
- (let* ((checkfile (concat gnus-current-startup-file ".eld"))
- (mtime (nth 5 (file-attributes checkfile))))
- (when (and gnus-save-newsrc-file-last-timestamp
- (time-less-p gnus-save-newsrc-file-last-timestamp
- mtime))
- (unless (y-or-n-p
- (format "%s was updated externally after %s, save?"
- checkfile
- (format-time-string
- "%c"
- gnus-save-newsrc-file-last-timestamp)))
- (error "Couldn't save %s: updated externally" checkfile)))))
+ (let* ((checkfile (concat gnus-current-startup-file ".eld"))
+ (mtime (nth 5 (file-attributes checkfile))))
+ (when (and gnus-save-newsrc-file-last-timestamp
+ (time-less-p gnus-save-newsrc-file-last-timestamp
+ mtime))
+ (unless (y-or-n-p
+ (format "%s was updated externally after %s, save?"
+ checkfile
+ (format-time-string
+ "%c"
+ gnus-save-newsrc-file-last-timestamp)))
+ (error "Couldn't save %s: updated externally" checkfile))))
(if gnus-save-startup-file-via-temp-buffer
(let ((coding-system-for-write gnus-ding-file-coding-system)
'mail-decode-encoded-address-string
"Function used to decode addresses with encoded words.")
-(defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups)
+(defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups X-GM-LABELS)
"*Extra headers to parse."
- :version "24.1" ; added Cc Keywords Gcc
+ :version "25.1"
:group 'gnus-summary
:type '(repeat symbol))
["Lapsed" gnus-article-date-lapsed t]
["User-defined" gnus-article-date-user t])
("Display"
+ ["Display HTML images" gnus-article-show-images t]
["Remove images" gnus-article-remove-images t]
["Toggle smiley" gnus-treat-smiley t]
["Show X-Face" gnus-article-display-x-face t]
(mm-decode-coding-string group charset)
(mm-decode-coding-string (gnus-status-message group) charset))))
- (unless (gnus-request-group group t)
+ (unless (gnus-request-group group t nil (gnus-get-info group))
(when (derived-mode-p 'gnus-summary-mode)
(gnus-kill-buffer (current-buffer)))
(error "Couldn't request group %s: %s"
(setq script (substring script 0 (match-beginning 0))
background 0))
(setq result
- (call-process shell-file-name nil background nil
+ (call-process shell-file-name nil stderr nil
shell-command-switch script))
- (when (and result
- (not (zerop result)))
- (set-buffer stderr)
- (message "Mail source error: %s" (buffer-string)))
- (kill-buffer stderr)))
+ (if (and result
+ (not (zerop result)))
+ (progn
+ (split-window-vertically)
+ (other-window 1)
+ (switch-to-buffer stderr)
+ (message "Mail source error: %s " (buffer-string)))
+ (kill-buffer stderr))))
;;;
;;; Different fetchers
(non-viewer . t)
(type . "application/zip")
("copiousoutput"))
+ ("pdf"
+ (viewer . pdf-view-mode)
+ (type . "application/pdf")
+ (test . (and (fboundp 'pdf-view-mode)
+ (eq window-system 'x))))
("pdf"
(viewer . doc-view-mode)
(type . "application/pdf")
%n The mail address, e.g. \"john.doe@example.invalid\".
%N The real name if present, e.g.: \"John Doe\", else fall
back to the mail address.
- %F The first name if present, e.g.: \"John\".
+ %F The first name if present, e.g.: \"John\", else fall
+ back to the mail address.
%L The last name if present, e.g.: \"Doe\".
%Z, %z The time zone in the numeric form, e.g.:\"+0000\".
;; "dead" nato bitnet uucp
"Regular expression that matches a valid FQDN."
;; see also: gnus-button-valid-fqdn-regexp
- :version "22.1"
+ :version "25.1"
:group 'message-headers
:type 'regexp)
(setq fname lname lname newlname)))))
;; The following letters are not used in `format-time-string':
(push ?E lst) (push "<E>" lst)
- (push ?F lst) (push fname lst)
+ (push ?F lst) (push (or fname name-or-net) lst)
;; We might want to use "" instead of "<X>" later.
(push ?J lst) (push "<J>" lst)
(push ?K lst) (push "<K>" lst)
(autoload 'gnus-replace-in-string "gnus-util")
(autoload 'gnus-read-shell-command "gnus-util")
+(autoload 'gnus-overlays-at "gnus")
+(autoload 'gnus-overlay-put "gnus")
+
(autoload 'mm-inline-partial "mm-partial")
(autoload 'mm-inline-external-body "mm-extern")
(autoload 'mm-extern-cache-contents "mm-extern")
(autoload 'mailcap-parse-mailcaps "mailcap")
(autoload 'mailcap-mime-info "mailcap")
+(defun mm-head-p (&optional point)
+ "Return non-nil if point is in the article header."
+ (let ((point (or point (point))))
+ (save-excursion
+ (goto-char point)
+ (and (not (re-search-backward "^$" nil t))
+ (re-search-forward "^$" nil t)))))
+
(defun mm-display-part (handle &optional no-default force)
"Display the MIME part represented by HANDLE.
Returns nil if the part is removed; inline if displayed inline;
'inline)
((and (mm-inlinable-p ehandle)
(mm-inlined-p ehandle))
+ (when force
+ (if (mm-head-p)
+ (re-search-forward "^$" nil t)
+ (forward-line 1)))
(mm-display-inline handle)
'inline)
((or method
(start end &optional base-url))
(declare-function shr-insert-document "shr" (dom))
(defvar shr-blocked-images)
+(defvar shr-use-fonts)
(defvar gnus-inhibit-images)
(autoload 'gnus-blocked-images "gnus-art")
;; Require since we bind its variables.
(require 'shr)
(let ((article-buffer (current-buffer))
- (shr-width fill-column)
+ (shr-width (if (and (boundp 'shr-use-fonts)
+ shr-use-fonts)
+ nil
+ fill-column))
(shr-content-function (lambda (id)
(let ((handle (mm-get-content-id id)))
(when handle
handle
`(lambda ()
(let ((inhibit-read-only t))
- (delete-region ,(copy-marker (point-min) t)
+ (delete-region ,(point-min-marker)
,(point-max-marker))))))))
(defvar shr-map)
:keymap shr-map
(get-text-property start 'shr-url))
(put-text-property start end 'local-map nil)
+ (dolist (overlay (gnus-overlays-at start))
+ (gnus-overlay-put overlay 'face nil))
(setq start end)))))
(defun mm-handle-filename (handle)
bound the default value of `enable-multibyte-characters' to nil while
evaluating FORMS but it is no longer done. So, some programs assuming
it if any may malfunction."
+ (declare (obsolete nil "25.1") (indent 0) (debug t))
(if (featurep 'xemacs)
`(progn ,@forms)
- (message "Warning: Using brain-dead macro `mm-with-unibyte-current-buffer'!")
(let ((multibyte (make-symbol "multibyte")))
`(let ((,multibyte enable-multibyte-characters))
(when ,multibyte
(progn ,@forms)
(when ,multibyte
(set-buffer-multibyte t)))))))
-(put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0)
-(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))
-(make-obsolete 'mm-with-unibyte-current-buffer nil "25.1")
(defun mm-find-charset-region (b e)
"Return a list of Emacs charsets in the region B to E."
handle
`(lambda ()
(let ((inhibit-read-only t))
- (delete-region ,(copy-marker (point-min) t)
+ (delete-region ,(point-min-marker)
,(point-max-marker)))))))))
(defvar mm-w3m-standalone-supports-m17n-p (if (featurep 'mule) 'undecided)
(nnimap-article-ranges (gnus-compress-sequence articles))
(nnimap-header-parameters))
t)
+ (unless (process-live-p (get-buffer-process (current-buffer)))
+ (error "Server closed connection"))
(nnimap-transform-headers)
(nnheader-remove-cr-followed-by-lf))
(insert-buffer-substring
group))
t))))
-(deffoo nnimap-request-scan-group (group &optional server info)
+(deffoo nnimap-request-group-scan (group &optional server info)
(setq group (nnimap-decode-gnus-group group))
- (let (marks high low)
- (with-current-buffer (nnimap-buffer)
- (erase-buffer)
- (let ((group-sequence
- (nnimap-send-command "SELECT %S" (utf7-encode group t)))
- (flag-sequence
- (nnimap-send-command "UID FETCH 1:* FLAGS")))
- (setf (nnimap-group nnimap-object) group)
- (nnimap-wait-for-response flag-sequence)
- (setq marks
- (nnimap-flags-to-marks
- (nnimap-parse-flags
- (list (list group-sequence flag-sequence
- 1 group "SELECT")))))
- (when (and info
- marks)
- (nnimap-update-infos marks (list info))
- (nnimap-store-info info (gnus-active (gnus-info-group info))))
- (goto-char (point-max))
- (let ((uidnext (nth 5 (car marks))))
- (setq high (or (if uidnext
- (1- uidnext)
- (nth 3 (car marks)))
- 0)
- low (or (nth 4 (car marks)) uidnext 1)))))
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (insert
- (format
- "211 %d %d %d %S\n" (1+ (- high low)) low high group))
- t)))
+ (when (nnimap-change-group nil server)
+ (let (marks high low)
+ (with-current-buffer (nnimap-buffer)
+ (erase-buffer)
+ (let ((group-sequence
+ (nnimap-send-command "SELECT %S" (utf7-encode group t)))
+ (flag-sequence
+ (nnimap-send-command "UID FETCH 1:* FLAGS")))
+ (setf (nnimap-group nnimap-object) group)
+ (nnimap-wait-for-response flag-sequence)
+ (setq marks
+ (nnimap-flags-to-marks
+ (nnimap-parse-flags
+ (list (list group-sequence flag-sequence
+ 1 group "SELECT")))))
+ (when (and info
+ marks)
+ (nnimap-update-infos marks (list info))
+ (nnimap-store-info info (gnus-active (gnus-info-group info))))
+ (goto-char (point-max))
+ (let ((uidnext (nth 5 (car marks))))
+ (setq high (or (if uidnext
+ (1- uidnext)
+ (nth 3 (car marks)))
+ 0)
+ low (or (nth 4 (car marks)) uidnext 1)))))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (insert
+ (format
+ "211 %d %d %d %S\n" (1+ (- high low)) low high group))
+ t))))
(deffoo nnimap-request-create-group (group &optional server args)
(setq group (nnimap-decode-gnus-group group))
(while (search-forward "* LIST " nil t)
(let ((flags (read (current-buffer)))
(separator (read (current-buffer)))
- (group (read (current-buffer))))
+ (group (buffer-substring-no-properties
+ (progn (skip-chars-forward " \"")
+ (point))
+ (progn (end-of-line)
+ (skip-chars-backward " \r\"")
+ (point)))))
(unless (member '%NoSelect flags)
(push (utf7-decode (if (stringp group)
group
(ranges (cdr spec)))
(if (eq group 'junk)
(setq junk-articles ranges)
- (push (list (nnimap-send-command
- "UID COPY %s %S"
- (nnimap-article-ranges ranges)
- (utf7-encode group t))
- ranges)
- sequences))))
+ ;; Don't copy if the message is already in its
+ ;; target group.
+ (unless (string= group nnimap-inbox)
+ (push (list (nnimap-send-command
+ "UID COPY %s %S"
+ (nnimap-article-ranges ranges)
+ (utf7-encode group t))
+ ranges)
+ sequences)))))
;; Wait for the last COPY response...
(when sequences
(nnimap-wait-for-response (caar sequences))
(eval-when-compile
(autoload 'nnimap-buffer "nnimap")
(autoload 'nnimap-command "nnimap")
- (autoload 'nnimap-capability "nnimap")
- (autoload 'nnimap-wait-for-line "nnimap")
(autoload 'nnimap-change-group "nnimap")
(autoload 'nnimap-make-thread-query "nnimap")
(autoload 'gnus-registry-action "gnus-registry")
(catch 'found
(mapcar
#'(lambda (group)
- (let (artlist)
- (condition-case ()
- (when (nnimap-change-group
- (gnus-group-short-name group) server)
- (with-current-buffer (nnimap-buffer)
- (message "Searching %s..." group)
- (let* ((arts 0)
- (literal+ (nnimap-capability "LITERAL+"))
- (search (split-string
- (if (string= criteria "")
- qstring
- (nnir-imap-make-query
- criteria qstring))
- "\n"))
- (coding (upcase
- (replace-regexp-in-string
- "-\\(unix\\|dos\\|mac\\)" ""
- (symbol-name
- (cdr default-process-coding-system)))))
- call result)
- (setq call (nnimap-send-command
- "UID SEARCH CHARSET %s %s" coding (pop search)))
- (while search ; Non-ascii search terms
- (unless literal+
- (nnimap-wait-for-line "^\\+\\(.*\\)\n"))
- (process-send-string (get-buffer-process (current-buffer)) (pop search))
- (process-send-string (get-buffer-process (current-buffer))
- (if (nnimap-newlinep nnimap-object)
- "\n"
- "\r\n")))
- (setq result (nnimap-get-response call))
- (mapc
- (lambda (artnum)
- (let ((artn (string-to-number artnum)))
- (when (> artn 0)
- (push (vector group artn 100)
- artlist)
- (when (assq 'shortcut query)
- (throw 'found (list artlist)))
- (setq arts (1+ arts)))))
- (and (car result)
- (cdr (assoc "SEARCH" (cdr result)))))
- (message "Searching %s... %d matches" group arts)))
- (message "Searching %s...done" group))
- (quit nil))
- (nreverse artlist)))
+ (let (artlist)
+ (condition-case ()
+ (when (nnimap-change-group
+ (gnus-group-short-name group) server)
+ (with-current-buffer (nnimap-buffer)
+ (message "Searching %s..." group)
+ (let ((arts 0)
+ (result (nnimap-command "UID SEARCH %s"
+ (if (string= criteria "")
+ qstring
+ (nnir-imap-make-query
+ criteria qstring)))))
+ (mapc
+ (lambda (artnum)
+ (let ((artn (string-to-number artnum)))
+ (when (> artn 0)
+ (push (vector group artn 100)
+ artlist)
+ (when (assq 'shortcut query)
+ (throw 'found (list artlist)))
+ (setq arts (1+ arts)))))
+ (and (car result)
+ (cdr (assoc "SEARCH" (cdr result)))))
+ (message "Searching %s... %d matches" group arts)))
+ (message "Searching %s...done" group))
+ (quit nil))
+ (nreverse artlist)))
groups))))))
(defun nnir-imap-make-query (criteria qstring)
(defun nnir-imap-expr-to-imap (criteria expr)
"Convert EXPR into an IMAP search expression on CRITERIA"
;; What sort of expression is this, eh?
- (let ((literal+ (nnimap-capability "LITERAL+")))
- (cond
- ;; Simple string term
- ((stringp expr)
- (format "%s %S" criteria expr))
- ;; Trivial term: and
- ((eq expr 'and) nil)
- ;; Composite term: or expression
- ((eq (car-safe expr) 'or)
- (format "OR %s %s"
- (nnir-imap-expr-to-imap criteria (second expr))
- (nnir-imap-expr-to-imap criteria (third expr))))
- ;; Composite term: just the fax, mam
- ((eq (car-safe expr) 'not)
- (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr))))
- ;; Composite term: non-ascii search term
- ((numberp (car-safe expr))
- (format "%s {%d%s}\n%s" criteria (car expr)
- (if literal+ "+" "") (second expr)))
- ;; Composite term: just expand it all.
- ((and (not (null expr)) (listp expr))
- (format "(%s)" (nnir-imap-query-to-imap criteria expr)))
- ;; Complex value, give up for now.
- (t (error "Unhandled input: %S" expr)))))
+ (cond
+ ;; Simple string term
+ ((stringp expr)
+ (format "%s %S" criteria expr))
+ ;; Trivial term: and
+ ((eq expr 'and) nil)
+ ;; Composite term: or expression
+ ((eq (car-safe expr) 'or)
+ (format "OR %s %s"
+ (nnir-imap-expr-to-imap criteria (second expr))
+ (nnir-imap-expr-to-imap criteria (third expr))))
+ ;; Composite term: just the fax, mam
+ ((eq (car-safe expr) 'not)
+ (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr))))
+ ;; Composite term: just expand it all.
+ ((and (not (null expr)) (listp expr))
+ (format "(%s)" (nnir-imap-query-to-imap criteria expr)))
+ ;; Complex value, give up for now.
+ (t (error "Unhandled input: %S" expr))))
(defun nnir-imap-parse-query (string)
((eq term 'and) 'and)
;; negated term
((eq term 'not) (list 'not (nnir-imap-next-expr)))
- ;; non-ascii search string
- ((and (stringp term)
- (not (= (string-bytes term)
- (length term))))
- (list (string-bytes term) term))
;; generic term
(t term))))
(when (functionp target)
(setq target (funcall target group)))
(unless (eq target 'delete)
- (when (or (gnus-request-group target)
+ (when (or (gnus-request-group target nil nil (gnus-get-info target))
(gnus-request-create-group target))
(let ((group-art (gnus-request-accept-article target nil nil t)))
(when (and (consp group-art)
&optional server force)
(nnmh-possibly-change-directory newsgroup server)
(let ((is-old t)
+ (dir nnmh-current-directory)
article rest mod-time)
(nnheader-init-server-buffer)
(while (and articles is-old)
- (setq article (concat nnmh-current-directory
- (int-to-string (car articles))))
+ (setq article (concat dir (int-to-string (car articles))))
(when (setq mod-time (nth 5 (file-attributes article)))
(if (and (nnmh-deletable-article-p newsgroup (car articles))
(setq is-old
context
(cons #'plstore-progress-callback-function
(format "Decrypting %s" (plstore-get-file plstore))))
- (setq plain
- (epg-decrypt-string context
- (plstore--get-encrypted-data plstore)))
+ (condition-case error
+ (setq plain
+ (epg-decrypt-string context
+ (plstore--get-encrypted-data plstore)))
+ (error
+ (let ((entry (assoc (plstore-get-file plstore)
+ plstore-passphrase-alist)))
+ (if entry
+ (setcdr entry nil)))
+ (signal (car error) (cdr error))))
(plstore--set-secret-alist plstore (car (read-from-string plain)))
(plstore--merge-secret plstore)
(plstore--set-encrypted-data plstore nil))))
:type (or null float)
:documentation "The registry version.")
(max-size :initarg :max-size
- ;; :initform most-positive-fixnum ;; see below
+ ;; EIEIO's :initform is not 100% compatible with CLOS in
+ ;; that if the form is an atom, it assumes it's constant
+ ;; value rather than an expression, so in order to get the value
+ ;; of `most-positive-fixnum', we need to use an
+ ;; expression that's not just a symbol.
+ :initform (symbol-value 'most-positive-fixnum)
:type integer
:custom integer
:documentation "The maximum number of registry entries.")
(data :initarg :data
:type hash-table
:documentation "The data hashtable.")))
-;; Do this separately, since defclass doesn't allow expressions in :initform.
-(oset-default 'registry-db max-size most-positive-fixnum)
(defmethod initialize-instance :BEFORE ((this registry-db) slots)
"Check whether a registry object needs to be upgraded."
(defmethod registry-lookup ((db registry-db) keys)
"Search for KEYS in the registry-db THIS.
Returns an alist of the key followed by the entry in a list, not a cons cell."
- (let ((data (oref db :data)))
+ (let ((data (oref db data)))
(delq nil
(mapcar
(lambda (k)
(defmethod registry-lookup-breaks-before-lexbind ((db registry-db) keys)
"Search for KEYS in the registry-db THIS.
Returns an alist of the key followed by the entry in a list, not a cons cell."
- (let ((data (oref db :data)))
+ (let ((data (oref db data)))
(delq nil
(loop for key in keys
when (gethash key data)
(when create
(puthash tracksym
(make-hash-table :size 800 :rehash-size 2.0 :test 'equal)
- (oref db :tracker))
- (gethash tracksym (oref db :tracker))))))
+ (oref db tracker))
+ (gethash tracksym (oref db tracker))))))
(defmethod registry-lookup-secondary-value ((db registry-db) tracksym val
&optional set)
(let ((all (plist-get spec :all))
(member (plist-get spec :member))
(regex (plist-get spec :regex)))
- (loop for k being the hash-keys of (oref db :data)
+ (loop for k being the hash-keys of (oref db data)
using (hash-values v)
when (or
;; :all non-nil returns all
If KEYS is nil, use SPEC to do a search.
Updates the secondary ('tracked') indices as well.
With assert non-nil, errors out if the key does not exist already."
- (let* ((data (oref db :data))
+ (let* ((data (oref db data))
(keys (or keys
(apply 'registry-search db spec)))
- (tracked (oref db :tracked)))
+ (tracked (oref db tracked)))
(dolist (key keys)
(let ((entry (gethash key data)))
(defmethod registry-size ((db registry-db))
"Returns the size of the registry-db object THIS.
-This is the key count of the :data slot."
- (hash-table-count (oref db :data)))
+This is the key count of the `data' slot."
+ (hash-table-count (oref db data)))
(defmethod registry-full ((db registry-db))
"Checks if registry-db THIS is full."
(>= (registry-size db)
- (oref db :max-size)))
+ (oref db max-size)))
(defmethod registry-insert ((db registry-db) key entry)
"Insert ENTRY under KEY into the registry-db THIS.
Updates the secondary ('tracked') indices as well.
Errors out if the key exists already."
- (assert (not (gethash key (oref db :data))) nil
+ (assert (not (gethash key (oref db data))) nil
"Key already exists in database")
(assert (not (registry-full db))
"registry max-size limit reached")
;; store the entry
- (puthash key entry (oref db :data))
+ (puthash key entry (oref db data))
;; store the secondary indices
- (dolist (tr (oref db :tracked))
+ (dolist (tr (oref db tracked))
;; for every value in the entry under that key...
(dolist (val (cdr-safe (assq tr entry)))
(let* ((value-keys (registry-lookup-secondary-value db tr val)))
(defmethod registry-reindex ((db registry-db))
"Rebuild the secondary indices of registry-db THIS."
(let ((count 0)
- (expected (* (length (oref db :tracked)) (registry-size db))))
- (dolist (tr (oref db :tracked))
+ (expected (* (length (oref db tracked)) (registry-size db))))
+ (dolist (tr (oref db tracked))
(let (values)
(maphash
(lambda (key v)
(let* ((value-keys (registry-lookup-secondary-value db tr val)))
(push key value-keys)
(registry-lookup-secondary-value db tr val value-keys))))
- (oref db :data))))))
+ (oref db data))))))
(defmethod registry-prune ((db registry-db) &optional sortfunc)
"Prunes the registry-db object DB.
Returns the number of deleted entries."
(let ((size (registry-size db))
- (target-size (- (oref db :max-size)
- (* (oref db :max-size)
- (oref db :prune-factor))))
+ (target-size
+ (floor (- (oref db max-size)
+ (* (oref db max-size)
+ (oref db prune-factor)))))
candidates)
- (if (> size target-size)
+ (if (registry-full db)
(progn
(setq candidates
(registry-collect-prune-candidates
Proposes only entries without the :precious keys, and attempts to
return LIMIT such candidates. If SORTFUNC is provided, sort
entries first and return candidates from beginning of list."
- (let* ((precious (oref db :precious))
+ (let* ((precious (oref db precious))
(precious-p (lambda (entry-key)
(cdr (memq (car entry-key) precious))))
- (data (oref db :data))
+ (data (oref db data))
(candidates (cl-loop for k being the hash-keys of data
using (hash-values v)
when (notany precious-p v)
;; list of entry keys.
(when sortfunc
(setq candidates (sort candidates sortfunc)))
- (delq nil (cl-subseq (mapcar #'car candidates) 0 limit))))
+ (cl-subseq (mapcar #'car candidates) 0 (min limit (length candidates)))))
(provide 'registry)
;;; registry.el ends here
(insert ".\n"))))
(defun help-fns--signature (function doc real-def real-function)
- (unless (keymapp function) ; If definition is a keymap, skip arglist note.
+ "Insert usage at point and return docstring. With highlighting."
+ (if (keymapp function)
+ doc ; 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)))
(buffer-string))))))))
+;;;###autoload
+(defun describe-function-or-variable (symbol &optional buffer frame)
+ "Display the full documentation of the function or variable SYMBOL.
+If SYMBOL is a variable and has a buffer-local value in BUFFER or FRAME
+\(default to the current buffer and current frame), it is displayed along
+with the global value."
+ (interactive
+ (let* ((v-or-f (variable-at-point))
+ (found (symbolp v-or-f))
+ (v-or-f (if found v-or-f (function-called-at-point)))
+ (found (or found v-or-f))
+ (enable-recursive-minibuffers t)
+ val)
+ (setq val (completing-read (if found
+ (format
+ "Describe function or variable (default %s): " v-or-f)
+ "Describe function or variable: ")
+ obarray
+ (lambda (vv)
+ (or (fboundp vv)
+ (get vv 'variable-documentation)
+ (and (boundp vv) (not (keywordp vv)))))
+ t nil nil
+ (if found (symbol-name v-or-f))))
+ (list (if (equal val "")
+ v-or-f (intern val)))))
+ (if (not (symbolp symbol)) (message "You didn't specify a function or variable")
+ (unless (buffer-live-p buffer) (setq buffer (current-buffer)))
+ (unless (frame-live-p frame) (setq frame (selected-frame)))
+ (help-xref-interned symbol buffer frame)))
+
;;;###autoload
(defun describe-syntax (&optional buffer)
"Describe the syntax specifications in the syntax table of BUFFER.
\f
;; Additional functions for (re-)creating types of help buffers.
-(defun help-xref-interned (symbol)
+
+;;;###autoload
+(defun help-xref-interned (symbol &optional buffer frame)
"Follow a hyperlink which appeared to be an arbitrary interned SYMBOL.
Both variable, function and face documentation are extracted into a single
-help buffer."
+help buffer. If SYMBOL is a variable, include buffer-local value for optional
+BUFFER or FRAME."
(with-current-buffer (help-buffer)
;; Push the previous item on the stack before clobbering the output buffer.
(help-setup-xref nil nil)
(get symbol 'variable-documentation))
;; Don't record the current entry in the stack.
(setq help-xref-stack-item nil)
- (describe-variable symbol))))
+ (describe-variable symbol buffer frame))))
(cond
(sdoc
;; We now have a help buffer on the variable.
(interactive)
(if help-xref-stack
(help-xref-go-back (current-buffer))
- (error "No previous help buffer")))
+ (user-error "No previous help buffer")))
(defun help-go-forward ()
"Go back to next topic in this help buffer."
(interactive)
(if help-xref-forward-stack
(help-xref-go-forward (current-buffer))
- (error "No next help buffer")))
+ (user-error "No next help buffer")))
(defun help-do-xref (_pos function args)
"Call the help cross-reference function FUNCTION with args ARGS.
a proper [back] button."
;; There is a reference at point. Follow it.
(let ((help-xref-following t))
- (apply function args)))
+ (apply function (if (eq function 'info)
+ (append args (list (generate-new-buffer-name "*info*"))) args))))
;; The doc string is meant to explain what buttons do.
(defun help-follow-mouse ()
For the cross-reference format, see `help-make-xrefs'."
(interactive)
- (error "No cross-reference here"))
+ (user-error "No cross-reference here"))
(defun help-follow-symbol (&optional pos)
"In help buffer, show docs for symbol at POS, defaulting to point.
(define-key map "k" 'describe-key)
(define-key map "l" 'view-lossage)
(define-key map "m" 'describe-mode)
+ (define-key map "o" 'describe-function-or-variable)
(define-key map "n" 'view-emacs-news)
(define-key map "p" 'finder-by-keyword)
(define-key map "P" 'describe-package)
m Display documentation of current minor modes and current major mode,
including their special commands.
n Display news of recent Emacs changes.
+o SYMBOL Display the given function or variable's documentation and value.
p TOPIC Find packages matching a given topic keyword.
P PACKAGE Describe the given Emacs Lisp package.
r Display the Emacs manual in Info mode.
;; Make `face' the next one to use by default.
(when (symbolp face) ;Don't add it if it's a list (bug#13297).
(add-to-list 'hi-lock--unused-faces (face-name face))))
- (font-lock-remove-keywords nil (list keyword))
+ ;; FIXME: Calling `font-lock-remove-keywords' causes
+ ;; `font-lock-specified-p' to go from nil to non-nil (because it
+ ;; calls font-lock-set-defaults). This is yet-another bug in
+ ;; font-lock-add/remove-keywords, which we circumvent here by
+ ;; testing `font-lock-fontified' (bug#19796).
+ (if font-lock-fontified (font-lock-remove-keywords nil (list keyword)))
(setq hi-lock-interactive-patterns
(delq keyword hi-lock-interactive-patterns))
(remove-overlays
(when ido-everywhere
(when (memq ido-mode '(both file))
(put 'ido-everywhere 'file (cons read-file-name-function nil))
- (setq read-file-name-function 'ido-read-file-name))
+ (setq read-file-name-function #'ido-read-file-name))
(when (memq ido-mode '(both buffer))
(put 'ido-everywhere 'buffer (cons read-buffer-function nil))
- (setq read-buffer-function 'ido-read-buffer))))
+ (setq read-buffer-function #'ido-read-buffer))))
(defvar ido-minor-mode-map-entry nil)
;; the file which the user might thought was still open.
(unless recentf-mode (recentf-mode 1))
(setq ido-virtual-buffers nil)
- (let (name)
- (dolist (head recentf-list)
+ (let ((bookmarks (and (boundp 'bookmark-alist)
+ bookmark-alist))
+ name)
+ (dolist (head (append
+ recentf-list
+ (delq nil (mapcar (lambda (bookmark)
+ (cdr (assoc 'filename bookmark)))
+ bookmarks))))
(setq name (file-name-nondirectory head))
;; In case HEAD is a directory with trailing /. See bug#14552.
(when (equal name "")
(put 'dired-do-rename 'ido 'ignore)
;;;###autoload
-(defun ido-read-buffer (prompt &optional default require-match)
+(defun ido-read-buffer (prompt &optional default require-match predicate)
"Ido replacement for the built-in `read-buffer'.
Return the name of a buffer selected.
PROMPT is the prompt to give to the user. DEFAULT if given is the default
(if (eq ido-exit 'fallback)
(let ((read-buffer-function nil))
(run-hook-with-args 'ido-before-fallback-functions 'read-buffer)
- (read-buffer prompt default require-match))
+ (read-buffer prompt default require-match predicate))
buf)))
;;;###autoload
(define-key map "a-" 'image-decrease-speed)
(define-key map "a0" 'image-reset-speed)
(define-key map "ar" 'image-reverse-speed)
+ (define-key map "k" 'image-kill-buffer)
(define-key map [remap forward-char] 'image-forward-hscroll)
(define-key map [remap backward-char] 'image-backward-hscroll)
(define-key map [remap right-char] 'image-forward-hscroll)
(image-mode-as-text)
(image-mode)))
+(defun image-kill-buffer ()
+ "Kill the current buffer."
+ (interactive)
+ (kill-buffer (current-buffer)))
+
(defun image-after-revert-hook ()
(when (image-get-display-property)
(image-toggle-display-text)
;; (or CTAN mirrors)
;; Perl: <URL:ftp://ftp.cpan.org/pub/CPAN/doc/manual/texinfo/> (or CPAN mirrors)
+;; Traditionally, makeinfo quoted `like this', but version 5 and later
+;; quotes 'like this' or ‘like this’. Doc specs with patterns
+;; therefore match open and close quotes with ['`‘] and ['’],
+;; respectively.
+
;;; Code:
(require 'info)
;; suffix "\\>" is not used because that sends DBL_MAX to
;; DBL_MAX_EXP ("_" is a non-word char)
("(libc)Variable Index" nil
- "^\\([ \t]+-+ \\(Variable\\|Macro\\): .*\\<\\|`\\)"
- "\\( \\|'?$\\)")
+ "^\\([ \t]+-+ \\(Variable\\|Macro\\): .*\\<\\|['`‘]\\)"
+ "\\( \\|['’]?$\\)")
("(libc)Type Index" nil
"^[ \t]+-+ Data Type: \\<" "\\>")
("(termcap)Var Index" nil
- "^[ \t]*`" "'"))
+ "^[ \t]*['`‘]" "['’]"))
:parse-rule 'info-lookup-guess-c-symbol)
(info-lookup-maybe-add-help
:mode 'bison-mode
:regexp "[:;|]\\|%\\([%{}]\\|[_a-z]+\\)\\|YY[_A-Z]+\\|yy[_a-z]+"
:doc-spec '(("(bison)Index" nil
- "`" "'"))
+ "['`‘]" "['’]"))
:parse-rule "[:;|]\\|%\\([%{}]\\|[_a-zA-Z][_a-zA-Z0-9]*\\)"
:other-modes '(c-mode))
:mode 'makefile-mode
:regexp "\\$[^({]\\|\\.[_A-Z]*\\|[_a-zA-Z][_a-zA-Z0-9-]*"
:doc-spec '(("(make)Name Index" nil
- "^[ \t]*`" "'"))
+ "^[ \t]*['`‘]" "['’]"))
:parse-rule "\\$[^({]\\|\\.[_A-Z]*\\|[_a-zA-Z0-9-]+")
(info-lookup-maybe-add-help
:doc-spec '(
;; "(automake)Macro Index" is autoconf macros used in
;; configure.ac, not Makefile.am, so don't have that here.
- ("(automake)Variable Index" nil "^[ \t]*`" "'")
+ ("(automake)Variable Index" nil "^[ \t]*['`‘]" "['’]")
;; In automake 1.4 macros and variables were a combined node.
- ("(automake)Macro and Variable Index" nil "^[ \t]*`" "'")
+ ("(automake)Macro and Variable Index" nil "^[ \t]*['`‘]"
+ "['’]")
;; Directives like "if" are in the "General Index".
;; Prefix "`" since the text for say `+=' isn't always an
;; @item etc and so not always at the start of a line.
- ("(automake)General Index" nil "`" "'")
+ ("(automake)General Index" nil "['`‘]" "['’]")
;; In automake 1.3 there was just a single "Index" node.
- ("(automake)Index" nil "`" "'"))
+ ("(automake)Index" nil "['`‘]" "['’]"))
:other-modes '(makefile-mode))
(info-lookup-maybe-add-help
(lambda (item)
(if (string-match "^\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\( .*\\)?$" item)
(concat "@" (match-string 1 item))))
- "`" "[' ]")))
+ "['`‘]" "['’ ]")))
(info-lookup-maybe-add-help
:mode 'm4-mode
;; macros (eg. AC_PROG_CC). Ensure this is after the autoconf
;; index, so as to prefer the autoconf docs.
("(automake)Macro and Variable Index" nil
- "^[ \t]*`" "'"))
+ "^[ \t]*['`‘]" "['’]"))
;; Autoconf symbols are M4 macros. Thus use M4's parser.
:parse-rule 'ignore
:other-modes '(m4-mode))
;; Built-in functions (matches to many entries).
((string-match "^[a-z]+$" item)
item))))
- "`" "\\([ \t]*([^)]*)\\)?'")))
+ "['`‘]" "\\([ \t]*([^)]*)\\)?['’]")))
(info-lookup-maybe-add-help
:mode 'perl-mode
;; From http://home.gna.org/latexrefman
"(latex2e)Command Index"
"(latex)Command Index")
- nil "`" "\\({[^}]*}\\)?'")))
+ ;; \frac{NUM}{DEN} etc can have more than one {xx} argument.
+ ;; \sqrt[ROOT]{num} and others can have square brackets.
+ nil "[`'‘]" "\\({[^}]*}|\\[[^]]*\\]\\)*['’]")))
+
(info-lookup-maybe-add-help
:mode 'emacs-lisp-mode
:regexp "[^][()`',\" \t\n]+"
:doc-spec '(;; Commands with key sequences appear in nodes as `foo' and
;; those without as `M-x foo'.
- ("(emacs)Command Index" nil "`\\(M-x[ \t\n]+\\)?" "'")
+ ("(emacs)Command Index" nil "['`‘]\\(M-x[ \t\n]+\\)?" "['’]")
;; Variables normally appear in nodes as just `foo'.
- ("(emacs)Variable Index" nil "`" "'")
+ ("(emacs)Variable Index" nil "['`‘]" "['’]")
;; Almost all functions, variables, etc appear in nodes as
;; " -- Function: foo" etc. A small number of aliases and
;; symbols appear only as `foo', and will miss out on exact
;; bash has "." and ":" in its index, but those chars will probably never
;; work in info, so don't bother matching them in the regexp.
:regexp "\\([a-zA-Z0-9_-]+\\|[!{}@*#?$]\\|\\[\\[?\\|]]?\\)"
- :doc-spec '(("(bash)Builtin Index" nil "^`" "[ .']")
- ("(bash)Reserved Word Index" nil "^`" "[ .']")
- ("(bash)Variable Index" nil "^`" "[ .']")
+ :doc-spec '(("(bash)Builtin Index" nil "^['`‘]" "[ .'’]")
+ ("(bash)Reserved Word Index" nil "^['`‘]" "[ .'’]")
+ ("(bash)Variable Index" nil "^['`‘]" "[ .'’]")
;; coreutils (version 4.5.10) doesn't have a separate program
;; index, so exclude extraneous stuff (most of it) by demanding
item))
;; This gets functions in evaluated classes. Other
;; possible patterns don't seem to work too well.
- "`" "(")))
+ "['`‘]" "(")))
(info-lookup-maybe-add-help
:mode 'Custom-mode
(cyrillic #x42F)
(armenian #x531)
(hebrew #x5D0)
+ (vai #xA500)
(arabic #x628)
(syriac #x710)
(thaana #x78C)
;; char with that name.
(setq ucs-names `(("BELL (BEL)" . 7) ,@names)))))
+(defun mule--ucs-names-annotation (name)
+ ;; FIXME: It would be much better to add this annotation before rather than
+ ;; after the char name, so the annotations are aligned.
+ ;; FIXME: The default behavior of displaying annotations in italics
+ ;; doesn't work well here.
+ (let ((char (assoc name ucs-names)))
+ (when char (format " (%c)" (cdr char)))))
+
(defun read-char-by-name (prompt)
"Read a character by its Unicode name or hex number string.
Display PROMPT and read a string that represents a character by its
prompt
(lambda (string pred action)
(if (eq action 'metadata)
- '(metadata (category . unicode-name))
+ '(metadata
+ (annotation-function . mule--ucs-names-annotation)
+ (category . unicode-name))
(complete-with-action action (ucs-names) string pred)))))
(char
(cond
See also the documentation of `quail-define-package'."
(nth 11 quail-current-package))
(defsubst quail-overlay-plist ()
- "Return property list of an overly used in the current Quail package."
+ "Return property list of an overlay used in the current Quail package."
(nth 12 quail-current-package))
(defsubst quail-update-translation-function ()
"Return a function for updating translation in the current Quail package."
overriding-local-map)
(list key)
(quail-setup-overlays (quail-conversion-keymap))
- (let ((modified-p (buffer-modified-p))
- (buffer-undo-list t)
- (inhibit-modification-hooks t))
+ (with-silent-modifications
(unwind-protect
(let ((input-string (if (quail-conversion-keymap)
(quail-start-conversion key)
(list (aref input-string 0))
(quail-input-string-to-events input-string))))
(quail-delete-overlays)
- (set-buffer-modified-p modified-p)
;; Run this hook only when the current input method doesn't require
;; conversion. When conversion is required, the conversion function
;; should run this hook at a proper timing.
;; killing iswitchb.el and then trying to switch back is broken
;; make sure TAB isn't broken
-(require 'iswitchb)
+;;; Code:
+
+(require 'iswitchb) ;FIXME: Don't rely on iswitchb!
(defgroup isearchb nil
"Switch between buffers using a mechanism like isearch."
(interactive)
(let* ((prompt "iswitch ")
(iswitchb-method 'samewindow)
- (buf (iswitchb-read-buffer prompt nil nil iswitchb-text t)))
+ (buf (iswitchb-read-buffer prompt nil nil nil iswitchb-text t)))
(if (eq iswitchb-exit 'findfile)
(call-interactively 'find-file)
(when buf
(min (point-max) (+ start jit-lock-chunk-size)))
'fontified 'defer)))))
+(defun jit-lock--run-functions (beg end)
+ (let ((tight-beg nil) (tight-end nil)
+ (loose-beg beg) (loose-end end))
+ (run-hook-wrapped
+ 'jit-lock-functions
+ (lambda (fun)
+ (pcase-let*
+ ((res (funcall fun beg end))
+ (`(,this-beg . ,this-end)
+ (if (eq (car-safe res) 'jit-lock-bounds)
+ (cdr res) (cons beg end))))
+ ;; If all functions don't fontify the same region, we currently
+ ;; just try to "still be correct". But we could go further and for
+ ;; the chunks of text that was fontified by some functions but not
+ ;; all, we could add text-properties indicating which functions were
+ ;; already run to avoid running them redundantly when we get to
+ ;; those chunks.
+ (setq tight-beg (max (or tight-beg (point-min)) this-beg))
+ (setq tight-end (min (or tight-end (point-max)) this-end))
+ (setq loose-beg (min loose-beg this-beg))
+ (setq loose-end (max loose-end this-end))
+ nil)))
+ `(,(min tight-beg beg) ,(max tight-end end) ,loose-beg ,loose-end)))
+
(defun jit-lock-fontify-now (&optional start end)
"Fontify current buffer from START to END.
Defaults to the whole buffer. END can be out of bounds."
(setq next (or (text-property-any start end 'fontified t)
end))
- ;; Decide which range of text should be fontified.
- ;; The problem is that START and NEXT may be in the
- ;; middle of something matched by a font-lock regexp.
- ;; Until someone has a better idea, let's start
- ;; at the start of the line containing START and
- ;; stop at the start of the line following NEXT.
- (goto-char next) (setq next (line-beginning-position 2))
- (goto-char start) (setq start (line-beginning-position))
-
- ;; Make sure the contextual refontification doesn't re-refontify
- ;; what's already been refontified.
- (when (and jit-lock-context-unfontify-pos
- (< jit-lock-context-unfontify-pos next)
- (>= jit-lock-context-unfontify-pos start)
- ;; Don't move boundary forward if we have to
- ;; refontify previous text. Otherwise, we risk moving
- ;; it past the end of the multiline property and thus
- ;; forget about this multiline region altogether.
- (not (get-text-property start 'jit-lock-defer-multiline)))
- (setq jit-lock-context-unfontify-pos next))
-
;; Fontify the chunk, and mark it as fontified.
;; We mark it first, to make sure that we don't indefinitely
;; re-execute this fontification if an error occurs.
(put-text-property start next 'fontified t)
- (condition-case err
- (run-hook-with-args 'jit-lock-functions start next)
- ;; If the user quits (which shouldn't happen in normal on-the-fly
- ;; jit-locking), make sure the fontification will be performed
- ;; before displaying the block again.
- (quit (put-text-property start next 'fontified nil)
- (funcall 'signal (car err) (cdr err))))
-
- ;; The redisplay engine has already rendered the buffer up-to
- ;; `orig-start' and won't notice if the above jit-lock-functions
- ;; changed the appearance of any part of the buffer prior
- ;; to that. So if `start' is before `orig-start', we need to
- ;; cause a new redisplay cycle after this one so that any changes
- ;; are properly reflected on screen.
- ;; To make such repeated redisplay happen less often, we can
- ;; eagerly extend the refontified region with
- ;; jit-lock-after-change-extend-region-functions.
- (when (< start orig-start)
- (run-with-timer 0 nil #'jit-lock-force-redisplay
- (copy-marker start) (copy-marker orig-start)))
-
- ;; Find the start of the next chunk, if any.
- (setq start (text-property-any next end 'fontified nil))))))))
+ (pcase-let
+ ;; `tight' is the part we've fully refontified, and `loose'
+ ;; is the part we've partly refontified (some of the
+ ;; functions have refontified it but maybe not all).
+ ((`(,tight-beg ,tight-end ,loose-beg ,_loose-end)
+ (condition-case err
+ (jit-lock--run-functions start next)
+ ;; If the user quits (which shouldn't happen in normal
+ ;; on-the-fly jit-locking), make sure the fontification
+ ;; will be performed before displaying the block again.
+ (quit (put-text-property start next 'fontified nil)
+ (signal (car err) (cdr err))))))
+
+ ;; In case we fontified more than requested, take advantage of the
+ ;; good news.
+ (when (or (< tight-beg start) (> tight-end next))
+ (put-text-property tight-beg tight-end 'fontified t))
+
+ ;; Make sure the contextual refontification doesn't re-refontify
+ ;; what's already been refontified.
+ (when (and jit-lock-context-unfontify-pos
+ (< jit-lock-context-unfontify-pos tight-end)
+ (>= jit-lock-context-unfontify-pos tight-beg)
+ ;; Don't move boundary forward if we have to
+ ;; refontify previous text. Otherwise, we risk moving
+ ;; it past the end of the multiline property and thus
+ ;; forget about this multiline region altogether.
+ (not (get-text-property tight-beg
+ 'jit-lock-defer-multiline)))
+ (setq jit-lock-context-unfontify-pos tight-end))
+
+ ;; The redisplay engine has already rendered the buffer up-to
+ ;; `orig-start' and won't notice if the above jit-lock-functions
+ ;; changed the appearance of any part of the buffer prior
+ ;; to that. So if `loose-beg' is before `orig-start', we need to
+ ;; cause a new redisplay cycle after this one so that the changes
+ ;; are properly reflected on screen.
+ ;; To make such repeated redisplay happen less often, we can
+ ;; eagerly extend the refontified region with
+ ;; jit-lock-after-change-extend-region-functions.
+ (when (< loose-beg orig-start)
+ (run-with-timer 0 nil #'jit-lock-force-redisplay
+ (copy-marker loose-beg)
+ (copy-marker orig-start)))
+
+ ;; Find the start of the next chunk, if any.
+ (setq start
+ (text-property-any tight-end end 'fontified nil)))))))))
(defun jit-lock-force-redisplay (start end)
"Force the display engine to re-render START's buffer from START to END.
(let ((jit-lock-start start)
(jit-lock-end end))
(with-buffer-prepared-for-jit-lock
- (run-hook-with-args 'jit-lock-after-change-extend-region-functions
- start end old-len)
- ;; Make sure we change at least one char (in case of deletions).
- (setq jit-lock-end (min (max jit-lock-end (1+ start)) (point-max)))
- ;; Request refontification.
- (put-text-property jit-lock-start jit-lock-end 'fontified nil))
+ (save-restriction
+ (widen)
+ (run-hook-with-args 'jit-lock-after-change-extend-region-functions
+ start end old-len)
+ ;; Make sure we change at least one char (in case of deletions).
+ (setq jit-lock-end (min (max jit-lock-end (1+ start)) (point-max)))
+ ;; Request refontification.
+ (put-text-property jit-lock-start jit-lock-end 'fontified nil)))
;; Mark the change for deferred contextual refontification.
(when jit-lock-context-unfontify-pos
(setq jit-lock-context-unfontify-pos
;;; Code:
-
-;; Compatibility code
-
-(defalias 'json-encode-char0 'encode-char)
-(defalias 'json-decode-char0 'decode-char)
-
-
;; Parameters
(defvar json-object-type 'alist
"Advance past the character at point, returning it."
(let ((char (json-peek)))
(if (eq char :json-eof)
- (signal 'end-of-file nil)
+ (signal 'json-end-of-file nil)
(json-advance)
char)))
(define-error 'json-string-format "Bad string format" 'json-error)
(define-error 'json-key-format "Bad JSON object key" 'json-error)
(define-error 'json-object-format "Bad JSON object" 'json-error)
+(define-error 'json-end-of-file "End of file while parsing JSON"
+ '(end-of-file json-error))
\f
(defvar json-special-chars
'((?\" . ?\")
(?\\ . ?\\)
- (?/ . ?/)
(?b . ?\b)
(?f . ?\f)
(?n . ?\n)
((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
(let ((hex (match-string 0)))
(json-advance 4)
- (json-decode-char0 'ucs (string-to-number hex 16))))
+ (string-to-number hex 16)))
(t
(signal 'json-string-escape (list (point)))))))
;; String encoding
-(defun json-encode-char (char)
- "Encode CHAR as a JSON string."
- (setq char (json-encode-char0 char 'ucs))
- (let ((control-char (car (rassoc char json-special-chars))))
- (cond
- ;; Special JSON character (\n, \r, etc.).
- (control-char
- (format "\\%c" control-char))
- ;; ASCIIish printable character.
- ((and (> char 31) (< char 127))
- (format "%c" char))
- ;; Fallback: UCS code point in \uNNNN form.
- (t
- (format "\\u%04x" char)))))
-
(defun json-encode-string (string)
"Return a JSON representation of STRING."
- (format "\"%s\"" (mapconcat 'json-encode-char string "")))
+ ;; Reimplement the meat of `replace-regexp-in-string', for
+ ;; performance (bug#20154).
+ (let ((l (length string))
+ (start 0)
+ res mb)
+ ;; Only escape quotation mark, backslash and the control
+ ;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
+ (while (setq mb (string-match "[\"\\[:cntrl:]]" string start))
+ (let* ((c (aref string mb))
+ (special (rassq c json-special-chars)))
+ (push (substring string start mb) res)
+ (push (if special
+ ;; Special JSON character (\n, \r, etc.).
+ (string ?\\ (car special))
+ ;; Fallback: UCS code point in \uNNNN form.
+ (format "\\u%04x" c))
+ res)
+ (setq start (1+ mb))))
+ (push (substring string start l) res)
+ (push "\"" res)
+ (apply #'concat "\"" (nreverse res))))
(defun json-encode-key (object)
"Return a JSON representation of OBJECT.
(if (functionp (car record))
(apply (car record) (cdr record))
(signal 'json-readtable-error record)))
- (signal 'end-of-file nil))))
+ (signal 'json-end-of-file nil))))
;; Syntactic sugar for the reader
;;;***
\f
-;;;### (autoloads nil "artist" "textmodes/artist.el" (21704 50495
-;;;;;; 455324 752000))
+;;;### (autoloads nil "artist" "textmodes/artist.el" (21750 59840
+;;;;;; 704617 663000))
;;; Generated autoloads from textmodes/artist.el
(push (purecopy '(artist 1 2 6)) package--builtin-versions)
;;;***
\f
-;;;### (autoloads nil "autorevert" "autorevert.el" (21670 32330 885624
-;;;;;; 725000))
+;;;### (autoloads nil "autorevert" "autorevert.el" (21752 15166 568176
+;;;;;; 278000))
;;; Generated autoloads from autorevert.el
(autoload 'auto-revert-mode "autorevert" "\
;;;***
\f
-;;;### (autoloads nil "battery" "battery.el" (21670 32330 885624
-;;;;;; 725000))
+;;;### (autoloads nil "battery" "battery.el" (21754 56896 744606
+;;;;;; 568000))
;;; Generated autoloads from battery.el
(put 'battery-mode-line-string 'risky-local-variable t)
;;;***
\f
-;;;### (autoloads nil "bookmark" "bookmark.el" (21670 32330 885624
-;;;;;; 725000))
+;;;### (autoloads nil "bookmark" "bookmark.el" (21779 56495 106033
+;;;;;; 935000))
;;; Generated autoloads from bookmark.el
(define-key ctl-x-r-map "b" 'bookmark-jump)
(define-key ctl-x-r-map "m" 'bookmark-set)
;;;***
\f
-;;;### (autoloads nil "browse-url" "net/browse-url.el" (21710 2878
-;;;;;; 794621 967000))
+;;;### (autoloads nil "browse-url" "net/browse-url.el" (21778 35636
+;;;;;; 244616 784000))
;;; Generated autoloads from net/browse-url.el
(defvar browse-url-browser-function 'browse-url-default-browser "\
(autoload 'browse-url "browse-url" "\
Ask a WWW browser to load URL.
-Prompts for a URL, defaulting to the URL at or before point. Variable
+Prompt for a URL, defaulting to the URL at or before point. Variable
`browse-url-browser-function' says which browser to use.
If the URL is a mailto: URL, consult `browse-url-mailto-function'
first, if that exists.
(autoload 'browse-url-at-point "browse-url" "\
Ask a WWW browser to load the URL at or before point.
-Doesn't let you edit the URL like `browse-url'. Variable
-`browse-url-browser-function' says which browser to use.
+Variable `browse-url-browser-function' says which browser to use.
\(fn &optional ARG)" t nil)
(autoload 'browse-url-at-mouse "browse-url" "\
Ask a WWW browser to load a URL clicked with the mouse.
The URL is the one around or before the position of the mouse click
-but point is not changed. Doesn't let you edit the URL like
-`browse-url'. Variable `browse-url-browser-function' says which browser
-to use.
+but point is not changed. Variable `browse-url-browser-function'
+says which browser to use.
\(fn EVENT)" t nil)
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-netscape 'nil '"25.1")
+
(autoload 'browse-url-mozilla "browse-url" "\
Ask the Mozilla WWW browser to load URL.
Default to the URL around or before point. The strings in variable
(autoload 'browse-url-firefox "browse-url" "\
Ask the Firefox WWW browser to load URL.
-Default to the URL around or before point. The strings in
-variable `browse-url-firefox-arguments' are also passed to
-Firefox.
+Defaults to the URL around or before point. Passes the strings
+in the variable `browse-url-firefox-arguments' to Firefox.
-When called interactively, if variable
-`browse-url-new-window-flag' is non-nil, load the document in a
-new Firefox window, otherwise use a random existing one. A
-non-nil interactive prefix argument reverses the effect of
-`browse-url-new-window-flag'.
+Interactively, if the variable `browse-url-new-window-flag' is non-nil,
+loads the document in a new Firefox window. A non-nil prefix argument
+reverses the effect of `browse-url-new-window-flag'.
If `browse-url-firefox-new-window-is-tab' is non-nil, then
whenever a document would otherwise be loaded in a new window, it
is loaded in a new tab in an existing window instead.
-When called non-interactively, optional second argument
-NEW-WINDOW is used instead of `browse-url-new-window-flag'.
-
-On MS-Windows systems the optional `new-window' parameter is
-ignored. Firefox for Windows does not support the \"-remote\"
-command line parameter. Therefore, the
-`browse-url-new-window-flag' and `browse-url-firefox-new-window-is-tab'
-are ignored as well. Firefox on Windows will always open the requested
-URL in a new window.
+Non-interactively, this uses the optional second argument NEW-WINDOW
+instead of `browse-url-new-window-flag'.
\(fn URL &optional NEW-WINDOW)" t nil)
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-galeon 'nil '"25.1")
+
(autoload 'browse-url-emacs "browse-url" "\
Ask Emacs to load URL into a buffer and show it in another window.
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-gnome-moz 'nil '"25.1")
+
(autoload 'browse-url-mosaic "browse-url" "\
Ask the XMosaic WWW browser to load URL.
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-mosaic 'nil '"25.1")
+
(autoload 'browse-url-cci "browse-url" "\
Ask the XMosaic WWW browser to load URL.
Default to the URL around or before point.
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-cci 'nil '"25.1")
+
+(autoload 'browse-url-conkeror "browse-url" "\
+Ask the Conkeror WWW browser to load URL.
+Default to the URL around or before point. Also pass the strings
+in the variable `browse-url-conkeror-arguments' to Conkeror.
+
+When called interactively, if variable
+`browse-url-new-window-flag' is non-nil, load the document in a
+new Conkeror window, otherwise use a random existing one. A
+non-nil interactive prefix argument reverses the effect of
+`browse-url-new-window-flag'.
+
+If variable `browse-url-conkeror-new-window-is-buffer' is
+non-nil, then whenever a document would otherwise be loaded in a
+new window, load it in a new buffer in an existing window instead.
+
+When called non-interactively, use optional second argument
+NEW-WINDOW instead of `browse-url-new-window-flag'.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
+
(autoload 'browse-url-w3 "browse-url" "\
Ask the w3 WWW browser to load URL.
Default to the URL around or before point.
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-w3-gnudoit 'nil '"25.1")
+
(autoload 'browse-url-text-xterm "browse-url" "\
Ask a text browser to load URL.
URL defaults to the URL around or before point.
;;;***
\f
-;;;### (autoloads nil "bytecomp" "emacs-lisp/bytecomp.el" (21696
-;;;;;; 56380 925320 624000))
+;;;### (autoloads nil "bytecomp" "emacs-lisp/bytecomp.el" (21729
+;;;;;; 53695 825320 214000))
;;; 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 "cc-engine" "progmodes/cc-engine.el" (21670
-;;;;;; 32331 385639 720000))
+;;;### (autoloads nil "cc-engine" "progmodes/cc-engine.el" (21743
+;;;;;; 190 195328 729000))
;;; Generated autoloads from progmodes/cc-engine.el
(autoload 'c-guess-basic-syntax "cc-engine" "\
;;;***
\f
-;;;### (autoloads nil "cc-mode" "progmodes/cc-mode.el" (21670 32331
-;;;;;; 385639 720000))
+;;;### (autoloads nil "cc-mode" "progmodes/cc-mode.el" (21786 29744
+;;;;;; 368212 633000))
;;; Generated autoloads from progmodes/cc-mode.el
(autoload 'c-initialize-cc-mode "cc-mode" "\
;;;***
\f
-;;;### (autoloads nil "cconv" "emacs-lisp/cconv.el" (21670 32330
-;;;;;; 885624 725000))
+;;;### (autoloads nil "cconv" "emacs-lisp/cconv.el" (21716 41663
+;;;;;; 456033 27000))
;;; Generated autoloads from emacs-lisp/cconv.el
(autoload 'cconv-closure-convert "cconv" "\
;;;***
\f
;;;### (autoloads nil "check-declare" "emacs-lisp/check-declare.el"
-;;;;;; (21670 32330 885624 725000))
+;;;;;; (21750 59840 206034 761000))
;;; Generated autoloads from emacs-lisp/check-declare.el
(autoload 'check-declare-file "check-declare" "\
;;;***
\f
-;;;### (autoloads nil "checkdoc" "emacs-lisp/checkdoc.el" (21670
-;;;;;; 32330 885624 725000))
+;;;### (autoloads nil "checkdoc" "emacs-lisp/checkdoc.el" (21779
+;;;;;; 56495 106033 935000))
;;; Generated autoloads from emacs-lisp/checkdoc.el
(push (purecopy '(checkdoc 0 6 2)) package--builtin-versions)
(put 'checkdoc-force-docstrings-flag 'safe-local-variable #'booleanp)
;;;***
\f
-;;;### (autoloads nil "cl-indent" "emacs-lisp/cl-indent.el" (21670
-;;;;;; 32330 885624 725000))
+;;;### (autoloads nil "cl-indent" "emacs-lisp/cl-indent.el" (21765
+;;;;;; 23600 805241 145000))
;;; Generated autoloads from emacs-lisp/cl-indent.el
(autoload 'common-lisp-indent-function "cl-indent" "\
;;;***
\f
-;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (21670 32330
-;;;;;; 885624 725000))
+;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (21777 14770
+;;;;;; 397461 322000))
;;; Generated autoloads from emacs-lisp/cl-lib.el
(push (purecopy '(cl-lib 1 0)) package--builtin-versions)
This variable is not used at present, but it is defined in hopes that
a future Emacs interpreter will be able to use it.")
-(define-error 'cl-assertion-failed (purecopy "Assertion failed"))
-
-(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 nil "cmacexp" "progmodes/cmacexp.el" (21670 32331
;;;***
\f
-;;;### (autoloads nil "comint" "comint.el" (21670 32330 885624 725000))
+;;;### (autoloads nil "comint" "comint.el" (21781 11826 448890 994000))
;;; 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 nil "cperl-mode" "progmodes/cperl-mode.el" (21670
-;;;;;; 32331 385639 720000))
+;;;### (autoloads nil "cperl-mode" "progmodes/cperl-mode.el" (21771
+;;;;;; 62389 36768 739000))
;;; 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 nil "css-mode" "textmodes/css-mode.el" (21669 40225
-;;;;;; 825176 608000))
+;;;### (autoloads nil "css-mode" "textmodes/css-mode.el" (21787 5486
+;;;;;; 8891 32000))
;;; Generated autoloads from textmodes/css-mode.el
(autoload 'css-mode "css-mode" "\
;;;***
\f
-;;;### (autoloads nil "dbus" "net/dbus.el" (21670 32331 385639 720000))
+;;;### (autoloads nil "dbus" "net/dbus.el" (21743 190 195328 729000))
;;; Generated autoloads from net/dbus.el
(autoload 'dbus-handle-event "dbus" "\
;;;***
\f
-;;;### (autoloads nil "debug" "emacs-lisp/debug.el" (21670 32330
-;;;;;; 885624 725000))
+;;;### (autoloads nil "debug" "emacs-lisp/debug.el" (21777 14770
+;;;;;; 397461 322000))
;;; Generated autoloads from emacs-lisp/debug.el
(setq debugger 'debug)
;;;***
\f
-;;;### (autoloads nil "delsel" "delsel.el" (21670 32330 885624 725000))
+;;;### (autoloads nil "delsel" "delsel.el" (21716 41663 456033 27000))
;;; Generated autoloads from delsel.el
(defalias 'pending-delete-mode 'delete-selection-mode)
;;;***
\f
-;;;### (autoloads nil "desktop" "desktop.el" (21691 38459 74604 918000))
+;;;### (autoloads nil "desktop" "desktop.el" (21753 36028 905339
+;;;;;; 955000))
;;; Generated autoloads from desktop.el
(defvar desktop-save-mode nil "\
;;;***
\f
-;;;### (autoloads nil "dired" "dired.el" (21670 32624 385626 484000))
+;;;### (autoloads nil "dired" "dired.el" (21757 29489 158925 687000))
;;; Generated autoloads from dired.el
(defvar dired-listing-switches (purecopy "-al") "\
;;;***
\f
-;;;### (autoloads nil "doc-view" "doc-view.el" (21670 32330 885624
-;;;;;; 725000))
+;;;### (autoloads nil "doc-view" "doc-view.el" (21716 41663 456033
+;;;;;; 27000))
;;; Generated autoloads from doc-view.el
(autoload 'doc-view-mode-p "doc-view" "\
;;;***
\f
-;;;### (autoloads nil "easy-mmode" "emacs-lisp/easy-mmode.el" (21708
-;;;;;; 47547 478182 210000))
+;;;### (autoloads nil "easy-mmode" "emacs-lisp/easy-mmode.el" (21732
+;;;;;; 29888 498897 471000))
;;; Generated autoloads from emacs-lisp/easy-mmode.el
(defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
BODY contains code to execute each time the mode is enabled or disabled.
It is executed after toggling the mode, and before running MODE-hook.
Before the actual body code, you can write keyword arguments, i.e.
- alternating keywords and values. These following special keywords
- are supported (other keywords are passed to `defcustom' if the minor
- mode is global):
+ alternating keywords and values. If you provide BODY, then you must
+ provide (even if just nil) INIT-VALUE, LIGHTER, and KEYMAP, or provide
+ at least one keyword argument, or both; otherwise, BODY would be
+ misinterpreted as the first omitted argument. The following special
+ keywords are supported (other keywords are passed to `defcustom' if
+ the minor mode is global):
:group GROUP Custom group name to use in all generated `defcustom' forms.
Defaults to MODE without the possible trailing \"-mode\".
;;;***
\f
-;;;### (autoloads nil "ede" "cedet/ede.el" (21679 47292 556033 759000))
+;;;### (autoloads nil "ede" "cedet/ede.el" (21715 20800 626041 761000))
;;; Generated autoloads from cedet/ede.el
(push (purecopy '(ede 1 2)) package--builtin-versions)
;;;***
\f
-;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (21670 32330
-;;;;;; 885624 725000))
+;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (21767 65327
+;;;;;; 504606 256000))
;;; Generated autoloads from emacs-lisp/edebug.el
(defvar edebug-all-defs nil "\
;;;***
\f
-;;;### (autoloads nil "eieio" "emacs-lisp/eieio.el" (21708 47547
-;;;;;; 478182 210000))
+;;;### (autoloads nil "eieio" "emacs-lisp/eieio.el" (21781 11826
+;;;;;; 448890 994000))
;;; Generated autoloads from emacs-lisp/eieio.el
(push (purecopy '(eieio 1 4)) package--builtin-versions)
;;;***
\f
-;;;### (autoloads nil "eieio-core" "emacs-lisp/eieio-core.el" (21708
-;;;;;; 47547 478182 210000))
+;;;### (autoloads nil "eieio-core" "emacs-lisp/eieio-core.el" (21770
+;;;;;; 41522 196747 399000))
;;; Generated autoloads from emacs-lisp/eieio-core.el
(push (purecopy '(eieio-core 1 4)) package--builtin-versions)
;;;***
\f
-;;;### (autoloads nil "elec-pair" "elec-pair.el" (21670 32330 885624
-;;;;;; 725000))
+;;;### (autoloads nil "elec-pair" "elec-pair.el" (21783 53552 656724
+;;;;;; 351000))
;;; Generated autoloads from elec-pair.el
(defvar electric-pair-text-pairs '((34 . 34)) "\
Electric Pair mode is a global minor mode. When enabled, typing
an open parenthesis automatically inserts the corresponding
-closing parenthesis. (Likewise for brackets, etc.).
+closing parenthesis. (Likewise for brackets, etc.). To toggle
+the mode in a single buffer, use `electric-pair-local-mode'.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'electric-pair-local-mode "elec-pair" "\
+Toggle `electric-pair-mode' only in this buffer.
\(fn &optional ARG)" t nil)
;;;***
\f
-;;;### (autoloads nil "epg" "epg.el" (21670 32330 885624 725000))
+;;;### (autoloads nil "epg" "epg.el" (21777 14770 397461 322000))
;;; Generated autoloads from epg.el
(push (purecopy '(epg 1 0 0)) package--builtin-versions)
;;;***
\f
-;;;### (autoloads nil "erc" "erc/erc.el" (21670 32330 885624 725000))
+;;;### (autoloads nil "erc" "erc/erc.el" (21779 56495 106033 935000))
;;; Generated autoloads from erc/erc.el
+(push (purecopy '(erc 5 3)) package--builtin-versions)
(autoload 'erc-select-read-args "erc" "\
Prompt the user for values of nick, server, port, and password.
;;;***
\f
-;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (21670
-;;;;;; 32330 885624 725000))
+;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (21727
+;;;;;; 11963 635339 992000))
;;; Generated autoloads from erc/erc-spelling.el
(autoload 'erc-spelling-mode "erc-spelling" nil t)
;;;***
\f
-;;;### (autoloads nil "esh-mode" "eshell/esh-mode.el" (21670 32330
-;;;;;; 885624 725000))
+;;;### (autoloads nil "esh-mode" "eshell/esh-mode.el" (21767 65327
+;;;;;; 504606 256000))
;;; Generated autoloads from eshell/esh-mode.el
(autoload 'eshell-mode "esh-mode" "\
;;;***
\f
-;;;### (autoloads nil "eww" "net/eww.el" (21702 8774 274627 813000))
+;;;### (autoloads nil "eww" "net/eww.el" (21753 36029 405318 957000))
;;; Generated autoloads from net/eww.el
+(defvar eww-suggest-uris '(eww-links-at-point url-get-url-at-point eww-current-url) "\
+List of functions called to form the list of default URIs for `eww'.
+Each of the elements is a function returning either a string or a list
+of strings. The results will be joined into a single list with
+duplicate entries (if any) removed.")
+
+(custom-autoload 'eww-suggest-uris "eww" t)
+
(autoload 'eww "eww" "\
Fetch URL and render the page.
If the input doesn't look like an URL or a domain name, the
(defalias 'browse-web 'eww)
(autoload 'eww-open-file "eww" "\
-Render a file using EWW.
+Render FILE using EWW.
\(fn FILE)" t nil)
(autoload 'eww-search-words "eww" "\
-Search the web for the text between the point and marker.
+Search the web for the text between BEG and END.
See the `eww-search-prefix' variable for the search engine used.
\(fn &optional BEG END)" t nil)
+(autoload 'eww-mode "eww" "\
+Mode for browsing the web.
+
+\(fn)" t nil)
+
(autoload 'eww-browse-url "eww" "\
;;;***
\f
-;;;### (autoloads nil "f90" "progmodes/f90.el" (21670 32331 385639
-;;;;;; 720000))
+;;;### (autoloads nil "f90" "progmodes/f90.el" (21740 23998 526747
+;;;;;; 884000))
;;; Generated autoloads from progmodes/f90.el
(autoload 'f90-mode "f90" "\
;;;***
\f
-;;;### (autoloads nil "ffap" "ffap.el" (21696 56380 925320 624000))
+;;;### (autoloads nil "ffap" "ffap.el" (21778 35636 244616 784000))
;;; Generated autoloads from ffap.el
(autoload 'ffap-next "ffap" "\
;;;***
\f
-;;;### (autoloads nil "filecache" "filecache.el" (21670 32330 885624
-;;;;;; 725000))
+;;;### (autoloads nil "filecache" "filecache.el" (21740 23998 26747
+;;;;;; 125000))
;;; Generated autoloads from filecache.el
(autoload 'file-cache-add-directory "filecache" "\
;;;***
\f
-;;;### (autoloads nil "flyspell" "textmodes/flyspell.el" (21670 32331
-;;;;;; 885635 586000))
+;;;### (autoloads nil "flyspell" "textmodes/flyspell.el" (21750 59840
+;;;;;; 704617 663000))
;;; Generated autoloads from textmodes/flyspell.el
(autoload 'flyspell-prog-mode "flyspell" "\
;;;***
\f
-;;;### (autoloads nil "frameset" "frameset.el" (21670 32330 885624
-;;;;;; 725000))
+;;;### (autoloads nil "frameset" "frameset.el" (21744 21055 525326
+;;;;;; 515000))
;;; Generated autoloads from frameset.el
(defvar frameset-session-filter-alist '((name . :never) (left . frameset-filter-iconified) (minibuffer . frameset-filter-minibuffer) (top . frameset-filter-iconified)) "\
;;;***
\f
-;;;### (autoloads nil "gamegrid" "play/gamegrid.el" (21696 56380
-;;;;;; 925320 624000))
+;;;### (autoloads nil "gamegrid" "play/gamegrid.el" (21720 38720
+;;;;;; 956749 443000))
;;; Generated autoloads from play/gamegrid.el
(push (purecopy '(gamegrid 1 2)) package--builtin-versions)
;;;***
\f
-;;;### (autoloads nil "gdb-mi" "progmodes/gdb-mi.el" (21670 32331
-;;;;;; 385639 720000))
+;;;### (autoloads nil "gdb-mi" "progmodes/gdb-mi.el" (21724 35774
+;;;;;; 954622 790000))
;;; Generated autoloads from progmodes/gdb-mi.el
(defvar gdb-enable-debug nil "\
;;;***
\f
-;;;### (autoloads nil "gnus-art" "gnus/gnus-art.el" (21670 32330
-;;;;;; 885624 725000))
+;;;### (autoloads nil "gnus-art" "gnus/gnus-art.el" (21785 8881 6781
+;;;;;; 649000))
;;; Generated autoloads from gnus/gnus-art.el
(autoload 'gnus-article-prepare-display "gnus-art" "\
;;;***
\f
-;;;### (autoloads nil "gnus-msg" "gnus/gnus-msg.el" (21670 32330
-;;;;;; 885624 725000))
+;;;### (autoloads nil "gnus-msg" "gnus/gnus-msg.el" (21725 56638
+;;;;;; 795320 63000))
;;; Generated autoloads from gnus/gnus-msg.el
(autoload 'gnus-msg-mail "gnus-msg" "\
;;;***
\f
;;;### (autoloads nil "gnus-notifications" "gnus/gnus-notifications.el"
-;;;;;; (21670 32330 885624 725000))
+;;;;;; (21757 29489 158925 687000))
;;; Generated autoloads from gnus/gnus-notifications.el
(autoload 'gnus-notifications "gnus-notifications" "\
;;;***
\f
-;;;### (autoloads nil "gnus-registry" "gnus/gnus-registry.el" (21707
-;;;;;; 26689 135319 638000))
+;;;### (autoloads nil "gnus-registry" "gnus/gnus-registry.el" (21774
+;;;;;; 38574 225319 550000))
;;; Generated autoloads from gnus/gnus-registry.el
(autoload 'gnus-registry-initialize "gnus-registry" "\
;;;***
\f
-;;;### (autoloads nil "gnus-start" "gnus/gnus-start.el" (21670 32330
-;;;;;; 885624 725000))
+;;;### (autoloads nil "gnus-start" "gnus/gnus-start.el" (21716 41663
+;;;;;; 456033 27000))
;;; Generated autoloads from gnus/gnus-start.el
(autoload 'gnus-declare-backend "gnus-start" "\
;;;***
\f
-;;;### (autoloads nil "gnus-sum" "gnus/gnus-sum.el" (21670 32330
-;;;;;; 885624 725000))
+;;;### (autoloads nil "gnus-sum" "gnus/gnus-sum.el" (21785 8881 6781
+;;;;;; 649000))
;;; Generated autoloads from gnus/gnus-sum.el
(autoload 'gnus-summary-bookmark-jump "gnus-sum" "\
;;;***
\f
-;;;### (autoloads nil "gud" "progmodes/gud.el" (21670 32331 385639
-;;;;;; 720000))
+;;;### (autoloads nil "gud" "progmodes/gud.el" (21769 20661 366048
+;;;;;; 601000))
;;; Generated autoloads from progmodes/gud.el
(autoload 'gud-gdb "gud" "\
;;;***
\f
-;;;### (autoloads nil "gv" "emacs-lisp/gv.el" (21670 32330 885624
-;;;;;; 725000))
+;;;### (autoloads nil "gv" "emacs-lisp/gv.el" (21750 59840 206034
+;;;;;; 761000))
;;; Generated autoloads from emacs-lisp/gv.el
(autoload 'gv-get "gv" "\
;;;***
\f
-;;;### (autoloads nil "help-fns" "help-fns.el" (21690 17600 745361
-;;;;;; 875000))
+;;;### (autoloads nil "help-fns" "help-fns.el" (21721 59582 784612
+;;;;;; 824000))
;;; Generated autoloads from help-fns.el
(autoload 'describe-function "help-fns" "\
\(fn VARIABLE &optional BUFFER FRAME)" t nil)
+(autoload 'describe-function-or-variable "help-fns" "\
+Display the full documentation of the function or variable SYMBOL.
+If SYMBOL is a variable and has a buffer-local value in BUFFER or FRAME
+\(default to the current buffer and current frame), it is displayed along
+with the global value.
+
+\(fn SYMBOL &optional BUFFER FRAME)" t nil)
+
(autoload 'describe-syntax "help-fns" "\
Describe the syntax specifications in the syntax table of BUFFER.
The descriptions are inserted in a help buffer, which is then displayed.
;;;***
\f
-;;;### (autoloads nil "help-mode" "help-mode.el" (21690 17600 745361
-;;;;;; 875000))
+;;;### (autoloads nil "help-mode" "help-mode.el" (21733 50750 334730
+;;;;;; 5000))
;;; Generated autoloads from help-mode.el
(autoload 'help-mode "help-mode" "\
\(fn FROM TO)" nil nil)
+(autoload 'help-xref-interned "help-mode" "\
+Follow a hyperlink which appeared to be an arbitrary interned SYMBOL.
+Both variable, function and face documentation are extracted into a single
+help buffer. If SYMBOL is a variable, include buffer-local value for optional
+BUFFER or FRAME.
+
+\(fn SYMBOL &optional BUFFER FRAME)" nil nil)
+
(autoload 'help-bookmark-jump "help-mode" "\
Jump to help-mode bookmark BOOKMARK.
Handler function for record returned by `help-bookmark-make-record'.
;;;***
\f
-;;;### (autoloads nil "hi-lock" "hi-lock.el" (21670 32331 385639
-;;;;;; 720000))
+;;;### (autoloads nil "hi-lock" "hi-lock.el" (21741 1161 438890 423000))
;;; Generated autoloads from hi-lock.el
(autoload 'hi-lock-mode "hi-lock" "\
;;;***
\f
-;;;### (autoloads nil "ido" "ido.el" (21694 14651 747488 989000))
+;;;### (autoloads nil "ido" "ido.el" (21767 65327 504606 256000))
;;; Generated autoloads from ido.el
(defvar ido-mode nil "\
buffer to be selected, which will go to the front of the list.
If REQUIRE-MATCH is non-nil, an existing buffer must be selected.
-\(fn PROMPT &optional DEFAULT REQUIRE-MATCH)" nil nil)
+\(fn PROMPT &optional DEFAULT REQUIRE-MATCH PREDICATE)" nil nil)
(autoload 'ido-read-file-name "ido" "\
Ido replacement for the built-in `read-file-name'.
;;;***
\f
-;;;### (autoloads nil "image-mode" "image-mode.el" (21670 32331 385639
-;;;;;; 720000))
+;;;### (autoloads nil "image-mode" "image-mode.el" (21716 41663 456033
+;;;;;; 27000))
;;; Generated autoloads from image-mode.el
(autoload 'image-mode "image-mode" "\
;;;***
\f
-;;;### (autoloads nil "info-look" "info-look.el" (21670 32331 385639
-;;;;;; 720000))
+;;;### (autoloads nil "info-look" "info-look.el" (21764 2734 445319
+;;;;;; 586000))
;;; Generated autoloads from info-look.el
(autoload 'info-lookup-reset "info-look" "\
;;;***
\f
-;;;### (autoloads nil "isearchb" "isearchb.el" (21670 32331 385639
-;;;;;; 720000))
+;;;### (autoloads nil "isearchb" "isearchb.el" (21767 65327 504606
+;;;;;; 256000))
;;; Generated autoloads from isearchb.el
(push (purecopy '(isearchb 1 5)) package--builtin-versions)
;;;***
\f
-;;;### (autoloads nil "ispell" "textmodes/ispell.el" (21670 32331
-;;;;;; 885635 586000))
+;;;### (autoloads nil "ispell" "textmodes/ispell.el" (21750 59840
+;;;;;; 704617 663000))
;;; Generated autoloads from textmodes/ispell.el
(put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive))))
;;;***
\f
-;;;### (autoloads nil "js" "progmodes/js.el" (21681 2618 385332 620000))
+;;;### (autoloads nil "js" "progmodes/js.el" (21760 5676 875320 615000))
;;; Generated autoloads from progmodes/js.el
(push (purecopy '(js 9)) package--builtin-versions)
;;;***
\f
-;;;### (autoloads nil "json" "json.el" (21670 32331 385639 720000))
+;;;### (autoloads nil "json" "json.el" (21779 56495 106033 935000))
;;; Generated autoloads from json.el
(push (purecopy '(json 1 4)) package--builtin-versions)
;;;***
\f
-;;;### (autoloads nil "message" "gnus/message.el" (21706 5826 304666
-;;;;;; 725000))
+;;;### (autoloads nil "message" "gnus/message.el" (21759 29151 445319
+;;;;;; 109000))
;;; 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 nil "misearch" "misearch.el" (21691 38459 74604
-;;;;;; 918000))
+;;;### (autoloads nil "misearch" "misearch.el" (21767 65327 504606
+;;;;;; 256000))
;;; Generated autoloads from misearch.el
(add-hook 'isearch-mode-hook 'multi-isearch-setup)
;;;***
\f
-;;;### (autoloads nil "network-stream" "net/network-stream.el" (21670
-;;;;;; 32331 385639 720000))
+;;;### (autoloads nil "network-stream" "net/network-stream.el" (21716
+;;;;;; 41663 456033 27000))
;;; Generated autoloads from net/network-stream.el
(autoload 'open-network-stream "network-stream" "\
;;;***
\f
-;;;### (autoloads nil "outline" "outline.el" (21708 47547 478182
-;;;;;; 210000))
+;;;### (autoloads nil "outline" "outline.el" (21720 38720 956749
+;;;;;; 443000))
;;; Generated autoloads from outline.el
(put 'outline-regexp 'safe-local-variable 'stringp)
(put 'outline-heading-end-regexp 'safe-local-variable 'stringp)
;;;***
\f
-;;;### (autoloads nil "package" "emacs-lisp/package.el" (21695 35516
-;;;;;; 595262 313000))
+;;;### (autoloads nil "package" "emacs-lisp/package.el" (21787 50612
+;;;;;; 215339 172000))
;;; Generated autoloads from emacs-lisp/package.el
(push (purecopy '(package 1 0 1)) package--builtin-versions)
(custom-autoload 'package-enable-at-startup "package" t)
+(autoload 'package-initialize "package" "\
+Load Emacs Lisp packages, and activate them.
+The variable `package-load-list' controls which packages to load.
+If optional arg NO-ACTIVATE is non-nil, don't activate packages.
+
+\(fn &optional NO-ACTIVATE)" t nil)
+
+(autoload 'package-import-keyring "package" "\
+Import keys from FILE.
+
+\(fn &optional FILE)" t nil)
+
+(autoload 'package-refresh-contents "package" "\
+Download descriptions of all configured ELPA packages.
+For each archive configured in the variable `package-archives',
+inform Emacs about the latest versions of all packages it offers,
+and make them available for download.
+Optional argument, ASYNC, specifies whether the downloads should
+be performed in the background.
+
+\(fn &optional ASYNC)" t nil)
+
(autoload 'package-install "package" "\
Install the package PKG.
PKG can be a package-desc or the package name of one the available packages
in an archive in `package-archives'. Interactively, prompt for its name.
-\(fn PKG)" t nil)
+If called interactively or if DONT-SELECT nil, add PKG to
+`package-selected-packages'.
+
+If PKG is a package-desc and it is already installed, don't try
+to install it but still mark it as selected.
+
+\(fn PKG &optional DONT-SELECT)" t nil)
(autoload 'package-install-from-buffer "package" "\
Install a package from the current buffer.
\(fn FILE)" t nil)
-(autoload 'package-import-keyring "package" "\
-Import keys from FILE.
+(autoload 'package-install-user-selected-packages "package" "\
+Ensure packages in `package-selected-packages' are installed.
+If some packages are not installed propose to install them.
-\(fn &optional FILE)" t nil)
+\(fn)" t nil)
-(autoload 'package-refresh-contents "package" "\
-Download the ELPA archive description if needed.
-This informs Emacs about the latest versions of all packages, and
-makes them available for download.
+(autoload 'package-reinstall "package" "\
+Reinstall package PKG.
+PKG should be either a symbol, the package name, or a package-desc
+object.
-\(fn)" t nil)
+\(fn PKG)" t nil)
-(autoload 'package-initialize "package" "\
-Load Emacs Lisp packages, and activate them.
-The variable `package-load-list' controls which packages to load.
-If optional arg NO-ACTIVATE is non-nil, don't activate packages.
+(autoload 'package-autoremove "package" "\
+Remove packages that are no more needed.
-\(fn &optional NO-ACTIVATE)" t nil)
+Packages that are no more needed by other packages in
+`package-selected-packages' and their dependencies
+will be deleted.
+
+\(fn)" t nil)
(autoload 'describe-package "package" "\
Display the full documentation of PACKAGE (a symbol).
;;;***
\f
-;;;### (autoloads nil "pcase" "emacs-lisp/pcase.el" (21670 32330
-;;;;;; 885624 725000))
+;;;### (autoloads nil "pcase" "emacs-lisp/pcase.el" (21777 14770
+;;;;;; 397461 322000))
;;; Generated autoloads from emacs-lisp/pcase.el
(autoload 'pcase "pcase" "\
(or UPAT...) matches if any of the patterns matches.
(and UPAT...) matches if all the patterns match.
'VAL matches if the object is `equal' to VAL
- `QPAT matches if the QPattern QPAT matches.
(pred FUN) matches if FUN applied to the object returns non-nil.
(guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
(let UPAT EXP) matches if EXP matches UPAT.
If a SYMBOL is used twice in the same pattern (i.e. the pattern is
\"non-linear\"), then the second occurrence is turned into an `eq'uality test.
-QPatterns can take the following forms:
- (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr.
- [QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match
- its 0..(n-1)th elements, respectively.
- ,UPAT matches if the UPattern UPAT matches.
- STRING matches if the object is `equal' to STRING.
- ATOM matches if the object is `eq' to ATOM.
-
FUN can take the form
SYMBOL or (lambda ARGS BODY) in which case it's called with one argument.
(F ARG1 .. ARGn) in which case F gets called with an n+1'th argument
like `(,a . ,(pred (< a))) or, with more checks:
`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))
+Additional patterns can be defined via `pcase-defmacro'.
+Currently, the following patterns are provided this way:
+
\(fn EXP &rest CASES)" nil t)
(function-put 'pcase 'lisp-indent-function '1)
(function-put 'pcase-exhaustive 'lisp-indent-function '1)
+(autoload 'pcase-lambda "pcase" "\
+Like `lambda' but allow each argument to be a UPattern.
+I.e. accepts the usual &optional and &rest keywords, but every
+formal argument can be any pattern accepted by `pcase' (a mere
+variable name being but a special case of it).
+
+\(fn LAMBDA-LIST &rest BODY)" nil t)
+
+(function-put 'pcase-lambda 'doc-string-elt '2)
+
+(function-put 'pcase-lambda 'lisp-indent-function 'defun)
+
(autoload 'pcase-let* "pcase" "\
Like `let*' but where you can use `pcase' patterns for bindings.
BODY should be an expression, and BINDINGS should be a list of bindings
;;;***
\f
-;;;### (autoloads nil "plstore" "gnus/plstore.el" (21670 32331 385639
-;;;;;; 720000))
+;;;### (autoloads nil "plstore" "gnus/plstore.el" (21786 29744 368212
+;;;;;; 633000))
;;; Generated autoloads from gnus/plstore.el
(autoload 'plstore-open "plstore" "\
;;;***
\f
-;;;### (autoloads nil "python" "progmodes/python.el" (21704 50495
-;;;;;; 455324 752000))
+;;;### (autoloads nil "python" "progmodes/python.el" (21781 11826
+;;;;;; 448890 994000))
;;; Generated autoloads from progmodes/python.el
-(push (purecopy '(python 0 24 4)) package--builtin-versions)
+(push (purecopy '(python 0 24 5)) package--builtin-versions)
(add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode))
;;;***
\f
-;;;### (autoloads nil "quail" "international/quail.el" (21673 8506
-;;;;;; 69195 402000))
+;;;### (autoloads nil "quail" "international/quail.el" (21761 26543
+;;;;;; 734945 674000))
;;; Generated autoloads from international/quail.el
(autoload 'quail-title "quail" "\
;;;***
\f
-;;;### (autoloads nil "quail/hangul" "leim/quail/hangul.el" (21670
-;;;;;; 32331 385639 720000))
+;;;### (autoloads nil "quail/hangul" "leim/quail/hangul.el" (21770
+;;;;;; 41522 196747 399000))
;;; Generated autoloads from leim/quail/hangul.el
(autoload 'hangul-input-method-activate "quail/hangul" "\
;;;***
\f
-;;;### (autoloads nil "rect" "rect.el" (21670 32331 885635 586000))
+;;;### (autoloads nil "rect" "rect.el" (21733 50750 334730 5000))
;;; Generated autoloads from rect.el
(autoload 'delete-rectangle "rect" "\
;;;***
\f
-;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (21670
-;;;;;; 32331 885635 586000))
+;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (21743
+;;;;;; 190 195328 729000))
;;; 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 nil "rmail" "mail/rmail.el" (21670 32623 885622
-;;;;;; 218000))
+;;;### (autoloads nil "rmail" "mail/rmail.el" (21756 8970 306748
+;;;;;; 51000))
;;; Generated autoloads from mail/rmail.el
(defvar rmail-file-name (purecopy "~/RMAIL") "\
;;;***
\f
-;;;### (autoloads nil "ruby-mode" "progmodes/ruby-mode.el" (21670
-;;;;;; 32331 385639 720000))
+;;;### (autoloads nil "ruby-mode" "progmodes/ruby-mode.el" (21771
+;;;;;; 62389 36768 739000))
;;; Generated autoloads from progmodes/ruby-mode.el
(push (purecopy '(ruby-mode 1 2)) package--builtin-versions)
;;;***
\f
-;;;### (autoloads nil "sendmail" "mail/sendmail.el" (21670 32331
-;;;;;; 385639 720000))
+;;;### (autoloads nil "sendmail" "mail/sendmail.el" (21786 29744
+;;;;;; 368212 633000))
;;; Generated autoloads from mail/sendmail.el
(defvar mail-from-style 'default "\
;;;***
\f
-;;;### (autoloads nil "seq" "emacs-lisp/seq.el" (21691 38459 74604
-;;;;;; 918000))
+;;;### (autoloads nil "seq" "emacs-lisp/seq.el" (21778 35636 244616
+;;;;;; 784000))
;;; Generated autoloads from emacs-lisp/seq.el
-(push (purecopy '(seq 1 0)) package--builtin-versions)
+(push (purecopy '(seq 1 3)) package--builtin-versions)
;;;***
\f
-;;;### (autoloads nil "server" "server.el" (21670 32331 885635 586000))
+;;;### (autoloads nil "server" "server.el" (21744 21055 525326 515000))
;;; Generated autoloads from server.el
(put 'server-host 'risky-local-variable t)
;;;***
\f
-;;;### (autoloads nil "sgml-mode" "textmodes/sgml-mode.el" (21670
-;;;;;; 32331 885635 586000))
+;;;### (autoloads nil "sgml-mode" "textmodes/sgml-mode.el" (21775
+;;;;;; 59440 64641 144000))
;;; Generated autoloads from textmodes/sgml-mode.el
(autoload 'sgml-mode "sgml-mode" "\
;;;***
\f
-;;;### (autoloads nil "shr" "net/shr.el" (21704 50495 455324 752000))
+;;;### (autoloads nil "shr" "net/shr.el" (21748 18111 534605 274000))
;;; Generated autoloads from net/shr.el
(autoload 'shr-render-region "shr" "\
;;;***
\f
-;;;### (autoloads nil "solar" "calendar/solar.el" (21670 32330 885624
-;;;;;; 725000))
+;;;### (autoloads nil "solar" "calendar/solar.el" (21735 6077 666769
+;;;;;; 364000))
;;; Generated autoloads from calendar/solar.el
(autoload 'sunrise-sunset "solar" "\
;;;***
\f
-;;;### (autoloads nil "sql" "progmodes/sql.el" (21670 32331 885635
-;;;;;; 586000))
+;;;### (autoloads nil "sql" "progmodes/sql.el" (21765 23600 805241
+;;;;;; 145000))
;;; Generated autoloads from progmodes/sql.el
-(push (purecopy '(sql 3 4)) package--builtin-versions)
+(push (purecopy '(sql 3 5)) package--builtin-versions)
(autoload 'sql-add-product-keywords "sql" "\
Add highlighting KEYWORDS for SQL PRODUCT.
;;;***
\f
-;;;### (autoloads nil "term" "term.el" (21670 32331 885635 586000))
+;;;### (autoloads nil "term" "term.el" (21775 59440 64641 144000))
;;; Generated autoloads from term.el
(autoload 'make-term "term" "\
;;;***
\f
-;;;### (autoloads nil "todo-mode" "calendar/todo-mode.el" (21670
-;;;;;; 32330 885624 725000))
+;;;### (autoloads nil "todo-mode" "calendar/todo-mode.el" (21750
+;;;;;; 59840 206034 761000))
;;; Generated autoloads from calendar/todo-mode.el
(autoload 'todo-show "todo-mode" "\
;;;***
\f
-;;;### (autoloads nil "tramp" "net/tramp.el" (21704 50495 455324
-;;;;;; 752000))
+;;;### (autoloads nil "tramp" "net/tramp.el" (21766 44463 655319
+;;;;;; 936000))
;;; Generated autoloads from net/tramp.el
(defvar tramp-mode t "\
Falls back to normal file name handler if no Tramp file name handler exists." (let ((directory-sep-char 47) (fn (assoc operation tramp-completion-file-name-handler-alist))) (if (and fn tramp-mode (or (eq tramp-syntax (quote sep)) (featurep (quote tramp)) (and (boundp (quote partial-completion-mode)) (symbol-value (quote partial-completion-mode))) (featurep (quote ido)) (featurep (quote icicles)))) (save-match-data (apply (cdr fn) args)) (tramp-completion-run-real-handler operation args))))
(defun tramp-autoload-file-name-handler (operation &rest args) "\
-Load Tramp file name handler, and perform OPERATION." (let ((default-directory (or (symbol-value (quote temporary-file-directory)) "/"))) (load "tramp" nil t)) (apply operation args))
+Load Tramp file name handler, and perform OPERATION." (let ((default-directory "/")) (load "tramp" nil t)) (apply operation args))
(defun tramp-register-autoload-file-name-handlers nil "\
Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list (quote file-name-handler-alist) (cons tramp-file-name-regexp (quote tramp-autoload-file-name-handler))) (put (quote tramp-autoload-file-name-handler) (quote safe-magic) t) (add-to-list (quote file-name-handler-alist) (cons tramp-completion-file-name-regexp (quote tramp-completion-file-name-handler))) (put (quote tramp-completion-file-name-handler) (quote safe-magic) t))
;;;***
\f
-;;;### (autoloads nil "url-handlers" "url/url-handlers.el" (21670
-;;;;;; 32331 885635 586000))
+;;;### (autoloads nil "url-handlers" "url/url-handlers.el" (21766
+;;;;;; 44463 655319 936000))
;;; Generated autoloads from url/url-handlers.el
(defvar url-handler-mode nil "\
;;;***
\f
-;;;### (autoloads nil "vc" "vc/vc.el" (21670 32331 885635 586000))
+;;;### (autoloads nil "vc" "vc/vc.el" (21748 18111 534605 274000))
;;; Generated autoloads from vc/vc.el
(defvar vc-checkout-hook nil "\
(custom-autoload 'vc-before-checkin-hook "vc" t)
+(autoload 'vc-responsible-backend "vc" "\
+Return the name of a backend system that is responsible for FILE.
+
+If FILE is already registered, return the
+backend of FILE. If FILE is not registered, then the
+first backend in `vc-handled-backends' that declares itself
+responsible for FILE is returned.
+
+\(fn FILE)" nil nil)
+
(autoload 'vc-next-action "vc" "\
Do the next logical version control operation on the current fileset.
This requires that all files in the current VC fileset be in the
;;;***
\f
-;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (21691 38459 74604
-;;;;;; 918000))
+;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (21744 21055 525326
+;;;;;; 515000))
;;; Generated autoloads from vc/vc-bzr.el
(defconst vc-bzr-admin-dirname ".bzr" "\
;;;***
\f
-;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (21670 32331 885635
-;;;;;; 586000))
+;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (21744 21055 525326
+;;;;;; 515000))
;;; Generated autoloads from vc/vc-cvs.el
(defun vc-cvs-registered (f)
"Return non-nil if file F is registered with CVS."
;;;***
\f
-;;;### (autoloads nil "vc-git" "vc/vc-git.el" (21670 32331 885635
-;;;;;; 586000))
+;;;### (autoloads nil "vc-git" "vc/vc-git.el" (21744 21055 525326
+;;;;;; 515000))
;;; 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" (21670 32331 885635 586000))
+;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (21744 21055 525326 515000))
;;; 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" (21670 32331 885635
-;;;;;; 586000))
+;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (21744 21055 525326
+;;;;;; 515000))
;;; Generated autoloads from vc/vc-mtn.el
(defconst vc-mtn-admin-dir "_MTN" "\
;;;***
\f
-;;;### (autoloads nil "vc-rcs" "vc/vc-rcs.el" (21670 32331 885635
-;;;;;; 586000))
+;;;### (autoloads nil "vc-rcs" "vc/vc-rcs.el" (21748 18111 534605
+;;;;;; 274000))
;;; Generated autoloads from vc/vc-rcs.el
(defvar vc-rcs-master-templates (purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) "\
;;;***
\f
-;;;### (autoloads nil "vc-sccs" "vc/vc-sccs.el" (21670 32331 885635
-;;;;;; 586000))
+;;;### (autoloads nil "vc-sccs" "vc/vc-sccs.el" (21748 18111 534605
+;;;;;; 274000))
;;; 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-src" "vc/vc-src.el" (21670 32331 885635
-;;;;;; 586000))
+;;;### (autoloads nil "vc-src" "vc/vc-src.el" (21748 18111 534605
+;;;;;; 274000))
;;; Generated autoloads from vc/vc-src.el
(defvar vc-src-master-templates (purecopy '("%s.src/%s,v")) "\
;;;***
\f
-;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (21688 62278 418203
-;;;;;; 119000))
+;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (21744 21055 525326
+;;;;;; 515000))
;;; Generated autoloads from vc/vc-svn.el
(defun vc-svn-registered (f)
(let ((admin-dir (cond ((and (eq system-type 'windows-nt)
;;;***
\f
;;;### (autoloads nil "verilog-mode" "progmodes/verilog-mode.el"
-;;;;;; (21670 32331 885635 586000))
+;;;;;; (21735 54828 874639 640000))
;;; Generated autoloads from progmodes/verilog-mode.el
(autoload 'verilog-mode "verilog-mode" "\
;;;***
\f
-;;;### (autoloads nil "vhdl-mode" "progmodes/vhdl-mode.el" (21670
-;;;;;; 32331 885635 586000))
+;;;### (autoloads nil "vhdl-mode" "progmodes/vhdl-mode.el" (21735
+;;;;;; 53834 375321 1000))
;;; Generated autoloads from progmodes/vhdl-mode.el
(autoload 'vhdl-mode "vhdl-mode" "\
VHDL STANDARDS:
The VHDL standards to be used are specified in option `vhdl-standard'.
- Available standards are: VHDL'87/'93(02), VHDL-AMS, and Math Packages.
+ Available standards are: VHDL'87/'93(02)/'08, VHDL-AMS, and Math Packages.
KEYWORD CASE:
;;;***
\f
-;;;### (autoloads nil "windmove" "windmove.el" (21670 32331 885635
-;;;;;; 586000))
+;;;### (autoloads nil "windmove" "windmove.el" (21733 50750 334730
+;;;;;; 5000))
;;; Generated autoloads from windmove.el
(autoload 'windmove-left "windmove" "\
;;;***
\f
-;;;### (autoloads nil "winner" "winner.el" (21670 32331 885635 586000))
+;;;### (autoloads nil "winner" "winner.el" (21733 50750 334730 5000))
;;; Generated autoloads from winner.el
(defvar winner-mode nil "\
;;;***
\f
-;;;### (autoloads nil "xref" "progmodes/xref.el" (21696 56380 925320
-;;;;;; 624000))
+;;;### (autoloads nil "xref" "progmodes/xref.el" (21739 3132 687120
+;;;;;; 143000))
;;; Generated autoloads from progmodes/xref.el
(autoload 'xref-pop-marker-stack "xref" "\
;;;***
\f
-;;;### (autoloads nil "xt-mouse" "xt-mouse.el" (21670 32331 885635
-;;;;;; 586000))
+;;;### (autoloads nil "xt-mouse" "xt-mouse.el" (21779 56495 106033
+;;;;;; 935000))
;;; Generated autoloads from xt-mouse.el
(defvar xterm-mouse-mode nil "\
\(fn &optional ARG)" t nil)
-;;;***
-\f
-;;;### (autoloads nil "xwidget" "xwidget.el" (21710 2878 794621 967000))
-;;; Generated autoloads from xwidget.el
-
-(autoload 'xwidget-webkit-browse-url "xwidget" "\
-Ask xwidget-webkit to browse URL.
-NEW-SESSION specifies whether to create a new xwidget-webkit session. URL
-defaults to the string looking like a url around the cursor position.
-
-\(fn URL &optional NEW-SESSION)" t nil)
-
;;;***
\f
;;;### (autoloads nil "yenc" "gnus/yenc.el" (21670 32331 385639 720000))
;;;;;; "calc/calc-fin.el" "calc/calc-forms.el" "calc/calc-frac.el"
;;;;;; "calc/calc-funcs.el" "calc/calc-graph.el" "calc/calc-help.el"
;;;;;; "calc/calc-incom.el" "calc/calc-keypd.el" "calc/calc-lang.el"
-;;;;;; "calc/calc-macs.el" "calc/calc-map.el" "calc/calc-math.el"
-;;;;;; "calc/calc-menu.el" "calc/calc-misc.el" "calc/calc-mode.el"
-;;;;;; "calc/calc-mtx.el" "calc/calc-nlfit.el" "calc/calc-poly.el"
-;;;;;; "calc/calc-prog.el" "calc/calc-rewr.el" "calc/calc-rules.el"
-;;;;;; "calc/calc-sel.el" "calc/calc-stat.el" "calc/calc-store.el"
-;;;;;; "calc/calc-stuff.el" "calc/calc-trail.el" "calc/calc-units.el"
-;;;;;; "calc/calc-vec.el" "calc/calc-yank.el" "calc/calcalg2.el"
-;;;;;; "calc/calcalg3.el" "calc/calccomp.el" "calc/calcsel2.el"
-;;;;;; "calendar/cal-bahai.el" "calendar/cal-coptic.el" "calendar/cal-french.el"
-;;;;;; "calendar/cal-html.el" "calendar/cal-islam.el" "calendar/cal-iso.el"
-;;;;;; "calendar/cal-julian.el" "calendar/cal-loaddefs.el" "calendar/cal-mayan.el"
-;;;;;; "calendar/cal-menu.el" "calendar/cal-move.el" "calendar/cal-persia.el"
-;;;;;; "calendar/cal-tex.el" "calendar/cal-x.el" "calendar/diary-loaddefs.el"
-;;;;;; "calendar/hol-loaddefs.el" "cdl.el" "cedet/cedet-cscope.el"
-;;;;;; "cedet/cedet-files.el" "cedet/cedet-global.el" "cedet/cedet-idutils.el"
-;;;;;; "cedet/ede/auto.el" "cedet/ede/autoconf-edit.el" "cedet/ede/base.el"
-;;;;;; "cedet/ede/config.el" "cedet/ede/cpp-root.el" "cedet/ede/custom.el"
-;;;;;; "cedet/ede/detect.el" "cedet/ede/dired.el" "cedet/ede/emacs.el"
-;;;;;; "cedet/ede/files.el" "cedet/ede/generic.el" "cedet/ede/linux.el"
-;;;;;; "cedet/ede/locate.el" "cedet/ede/make.el" "cedet/ede/makefile-edit.el"
-;;;;;; "cedet/ede/pconf.el" "cedet/ede/pmake.el" "cedet/ede/proj-archive.el"
-;;;;;; "cedet/ede/proj-aux.el" "cedet/ede/proj-comp.el" "cedet/ede/proj-elisp.el"
-;;;;;; "cedet/ede/proj-info.el" "cedet/ede/proj-misc.el" "cedet/ede/proj-obj.el"
-;;;;;; "cedet/ede/proj-prog.el" "cedet/ede/proj-scheme.el" "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/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.el" "cedet/semantic/bovine/debug.el"
+;;;;;; "calc/calc-loaddefs.el" "calc/calc-macs.el" "calc/calc-map.el"
+;;;;;; "calc/calc-math.el" "calc/calc-menu.el" "calc/calc-misc.el"
+;;;;;; "calc/calc-mode.el" "calc/calc-mtx.el" "calc/calc-nlfit.el"
+;;;;;; "calc/calc-poly.el" "calc/calc-prog.el" "calc/calc-rewr.el"
+;;;;;; "calc/calc-rules.el" "calc/calc-sel.el" "calc/calc-stat.el"
+;;;;;; "calc/calc-store.el" "calc/calc-stuff.el" "calc/calc-trail.el"
+;;;;;; "calc/calc-units.el" "calc/calc-vec.el" "calc/calc-yank.el"
+;;;;;; "calc/calcalg2.el" "calc/calcalg3.el" "calc/calccomp.el"
+;;;;;; "calc/calcsel2.el" "calendar/cal-bahai.el" "calendar/cal-coptic.el"
+;;;;;; "calendar/cal-french.el" "calendar/cal-html.el" "calendar/cal-islam.el"
+;;;;;; "calendar/cal-iso.el" "calendar/cal-julian.el" "calendar/cal-loaddefs.el"
+;;;;;; "calendar/cal-mayan.el" "calendar/cal-menu.el" "calendar/cal-move.el"
+;;;;;; "calendar/cal-persia.el" "calendar/cal-tex.el" "calendar/cal-x.el"
+;;;;;; "calendar/diary-loaddefs.el" "calendar/hol-loaddefs.el" "cdl.el"
+;;;;;; "cedet/cedet-cscope.el" "cedet/cedet-files.el" "cedet/cedet-global.el"
+;;;;;; "cedet/cedet-idutils.el" "cedet/ede/auto.el" "cedet/ede/autoconf-edit.el"
+;;;;;; "cedet/ede/base.el" "cedet/ede/config.el" "cedet/ede/cpp-root.el"
+;;;;;; "cedet/ede/custom.el" "cedet/ede/detect.el" "cedet/ede/dired.el"
+;;;;;; "cedet/ede/emacs.el" "cedet/ede/files.el" "cedet/ede/generic.el"
+;;;;;; "cedet/ede/linux.el" "cedet/ede/loaddefs.el" "cedet/ede/locate.el"
+;;;;;; "cedet/ede/make.el" "cedet/ede/makefile-edit.el" "cedet/ede/pconf.el"
+;;;;;; "cedet/ede/pmake.el" "cedet/ede/proj-archive.el" "cedet/ede/proj-aux.el"
+;;;;;; "cedet/ede/proj-comp.el" "cedet/ede/proj-elisp.el" "cedet/ede/proj-info.el"
+;;;;;; "cedet/ede/proj-misc.el" "cedet/ede/proj-obj.el" "cedet/ede/proj-prog.el"
+;;;;;; "cedet/ede/proj-scheme.el" "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/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.el" "cedet/semantic/bovine/debug.el"
;;;;;; "cedet/semantic/bovine/el.el" "cedet/semantic/bovine/gcc.el"
;;;;;; "cedet/semantic/bovine/make.el" "cedet/semantic/bovine/scm.el"
;;;;;; "cedet/semantic/chart.el" "cedet/semantic/complete.el" "cedet/semantic/ctxt.el"
;;;;;; "cedet/semantic/fw.el" "cedet/semantic/grammar-wy.el" "cedet/semantic/grammar.el"
;;;;;; "cedet/semantic/html.el" "cedet/semantic/ia-sb.el" "cedet/semantic/ia.el"
;;;;;; "cedet/semantic/idle.el" "cedet/semantic/imenu.el" "cedet/semantic/java.el"
-;;;;;; "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el" "cedet/semantic/mru-bookmark.el"
-;;;;;; "cedet/semantic/sb.el" "cedet/semantic/scope.el" "cedet/semantic/senator.el"
-;;;;;; "cedet/semantic/sort.el" "cedet/semantic/symref.el" "cedet/semantic/symref/cscope.el"
-;;;;;; "cedet/semantic/symref/filter.el" "cedet/semantic/symref/global.el"
-;;;;;; "cedet/semantic/symref/grep.el" "cedet/semantic/symref/idutils.el"
-;;;;;; "cedet/semantic/symref/list.el" "cedet/semantic/tag-file.el"
-;;;;;; "cedet/semantic/tag-ls.el" "cedet/semantic/tag-write.el"
+;;;;;; "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el" "cedet/semantic/loaddefs.el"
+;;;;;; "cedet/semantic/mru-bookmark.el" "cedet/semantic/sb.el" "cedet/semantic/scope.el"
+;;;;;; "cedet/semantic/senator.el" "cedet/semantic/sort.el" "cedet/semantic/symref.el"
+;;;;;; "cedet/semantic/symref/cscope.el" "cedet/semantic/symref/filter.el"
+;;;;;; "cedet/semantic/symref/global.el" "cedet/semantic/symref/grep.el"
+;;;;;; "cedet/semantic/symref/idutils.el" "cedet/semantic/symref/list.el"
+;;;;;; "cedet/semantic/tag-file.el" "cedet/semantic/tag-ls.el" "cedet/semantic/tag-write.el"
;;;;;; "cedet/semantic/tag.el" "cedet/semantic/texi.el" "cedet/semantic/util-modes.el"
;;;;;; "cedet/semantic/util.el" "cedet/semantic/wisent.el" "cedet/semantic/wisent/comp.el"
;;;;;; "cedet/semantic/wisent/java-tags.el" "cedet/semantic/wisent/javascript.el"
;;;;;; "cedet/srecode/el.el" "cedet/srecode/expandproto.el" "cedet/srecode/extract.el"
;;;;;; "cedet/srecode/fields.el" "cedet/srecode/filters.el" "cedet/srecode/find.el"
;;;;;; "cedet/srecode/getset.el" "cedet/srecode/insert.el" "cedet/srecode/java.el"
-;;;;;; "cedet/srecode/map.el" "cedet/srecode/mode.el" "cedet/srecode/semantic.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" "dom.el" "dos-fns.el" "dos-vars.el" "dos-w32.el"
-;;;;;; "dynamic-setting.el" "emacs-lisp/avl-tree.el" "emacs-lisp/bindat.el"
-;;;;;; "emacs-lisp/byte-opt.el" "emacs-lisp/cl-extra.el" "emacs-lisp/cl-generic.el"
-;;;;;; "emacs-lisp/cl-macs.el" "emacs-lisp/cl-seq.el" "emacs-lisp/cl.el"
-;;;;;; "emacs-lisp/eieio-base.el" "emacs-lisp/eieio-compat.el" "emacs-lisp/eieio-custom.el"
+;;;;;; "cedet/srecode/loaddefs.el" "cedet/srecode/map.el" "cedet/srecode/mode.el"
+;;;;;; "cedet/srecode/semantic.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" "dom.el" "dos-fns.el"
+;;;;;; "dos-vars.el" "dos-w32.el" "dynamic-setting.el" "emacs-lisp/avl-tree.el"
+;;;;;; "emacs-lisp/bindat.el" "emacs-lisp/byte-opt.el" "emacs-lisp/cl-extra.el"
+;;;;;; "emacs-lisp/cl-generic.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-compat.el" "emacs-lisp/eieio-custom.el"
;;;;;; "emacs-lisp/eieio-datadebug.el" "emacs-lisp/eieio-opt.el"
-;;;;;; "emacs-lisp/eieio-speedbar.el" "emacs-lisp/lisp-mnt.el" "emacs-lisp/package-x.el"
-;;;;;; "emacs-lisp/smie.el" "emacs-lisp/subr-x.el" "emacs-lisp/tcover-ses.el"
-;;;;;; "emacs-lisp/tcover-unsafep.el" "emacs-parallel/parallel-remote.el"
-;;;;;; "emacs-parallel/parallel-xwidget.el" "emacs-parallel/parallel.el"
+;;;;;; "emacs-lisp/eieio-speedbar.el" "emacs-lisp/generator.el"
+;;;;;; "emacs-lisp/lisp-mnt.el" "emacs-lisp/package-x.el" "emacs-lisp/smie.el"
+;;;;;; "emacs-lisp/subr-x.el" "emacs-lisp/tcover-ses.el" "emacs-lisp/tcover-unsafep.el"
;;;;;; "emulation/cua-gmrk.el" "emulation/edt-lk201.el" "emulation/edt-mapper.el"
;;;;;; "emulation/edt-pc.el" "emulation/edt-vt100.el" "emulation/viper-cmd.el"
;;;;;; "emulation/viper-ex.el" "emulation/viper-init.el" "emulation/viper-keym.el"
;;;;;; "eshell/em-script.el" "eshell/em-smart.el" "eshell/em-term.el"
;;;;;; "eshell/em-tramp.el" "eshell/em-unix.el" "eshell/em-xtra.el"
;;;;;; "eshell/esh-arg.el" "eshell/esh-cmd.el" "eshell/esh-ext.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" "format-spec.el" "fringe.el" "generic-x.el"
-;;;;;; "gnus/compface.el" "gnus/gnus-async.el" "gnus/gnus-bcklg.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" "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-cloud.el" "gnus/gnus-cus.el"
;;;;;; "gnus/gnus-demon.el" "gnus/gnus-dup.el" "gnus/gnus-eform.el"
;;;;;; "gnus/gnus-ems.el" "gnus/gnus-icalendar.el" "gnus/gnus-int.el"
;;;;;; "gnus/nnmh.el" "gnus/nnnil.el" "gnus/nnoo.el" "gnus/nnregistry.el"
;;;;;; "gnus/nnrss.el" "gnus/nnspool.el" "gnus/nntp.el" "gnus/nnvirtual.el"
;;;;;; "gnus/nnweb.el" "gnus/registry.el" "gnus/rfc1843.el" "gnus/rfc2045.el"
-;;;;;; "gnus/rfc2047.el" "gnus/rfc2104.el" "gnus/rfc2231.el" "gnus/rtree.el"
-;;;;;; "gnus/sieve-manage.el" "gnus/smime.el" "gnus/spam-stat.el"
-;;;;;; "gnus/spam-wash.el" "hex-util.el" "hfy-cmap.el" "ibuf-ext.el"
-;;;;;; "international/cp51932.el" "international/eucjp-ms.el" "international/fontset.el"
-;;;;;; "international/iso-ascii.el" "international/ja-dic-cnv.el"
+;;;;;; "gnus/rfc2047.el" "gnus/rfc2231.el" "gnus/rtree.el" "gnus/sieve-manage.el"
+;;;;;; "gnus/smime.el" "gnus/spam-stat.el" "gnus/spam-wash.el" "hex-util.el"
+;;;;;; "hfy-cmap.el" "ibuf-ext.el" "international/cp51932.el" "international/eucjp-ms.el"
+;;;;;; "international/fontset.el" "international/iso-ascii.el" "international/ja-dic-cnv.el"
;;;;;; "international/ja-dic-utl.el" "international/ogonek.el" "kermit.el"
;;;;;; "language/hanja-util.el" "language/thai-word.el" "ldefs-boot.el"
;;;;;; "leim/quail/arabic.el" "leim/quail/croatian.el" "leim/quail/cyril-jis.el"
;;;;;; "net/dns.el" "net/eudc-vars.el" "net/eudcb-bbdb.el" "net/eudcb-ldap.el"
;;;;;; "net/eudcb-mab.el" "net/eudcb-ph.el" "net/hmac-def.el" "net/hmac-md5.el"
;;;;;; "net/imap.el" "net/ldap.el" "net/mairix.el" "net/newsticker.el"
-;;;;;; "net/nsm.el" "net/sasl-cram.el" "net/sasl-digest.el" "net/sasl.el"
-;;;;;; "net/shr-color.el" "net/soap-client.el" "net/soap-inspect.el"
-;;;;;; "net/socks.el" "net/tls.el" "net/tramp-adb.el" "net/tramp-cache.el"
-;;;;;; "net/tramp-cmds.el" "net/tramp-compat.el" "net/tramp-gvfs.el"
-;;;;;; "net/tramp-gw.el" "net/tramp-loaddefs.el" "net/tramp-sh.el"
-;;;;;; "net/tramp-smb.el" "net/tramp-uu.el" "net/trampver.el" "net/zeroconf.el"
-;;;;;; "notifications.el" "nxml/nxml-enc.el" "nxml/nxml-maint.el"
-;;;;;; "nxml/nxml-ns.el" "nxml/nxml-outln.el" "nxml/nxml-parse.el"
-;;;;;; "nxml/nxml-rap.el" "nxml/nxml-util.el" "nxml/rng-dt.el" "nxml/rng-loc.el"
-;;;;;; "nxml/rng-maint.el" "nxml/rng-match.el" "nxml/rng-parse.el"
-;;;;;; "nxml/rng-pttrn.el" "nxml/rng-uri.el" "nxml/rng-util.el"
-;;;;;; "nxml/xsd-regexp.el" "org/ob-C.el" "org/ob-R.el" "org/ob-asymptote.el"
-;;;;;; "org/ob-awk.el" "org/ob-calc.el" "org/ob-clojure.el" "org/ob-comint.el"
-;;;;;; "org/ob-core.el" "org/ob-css.el" "org/ob-ditaa.el" "org/ob-dot.el"
-;;;;;; "org/ob-emacs-lisp.el" "org/ob-eval.el" "org/ob-exp.el" "org/ob-fortran.el"
-;;;;;; "org/ob-gnuplot.el" "org/ob-haskell.el" "org/ob-io.el" "org/ob-java.el"
-;;;;;; "org/ob-js.el" "org/ob-keys.el" "org/ob-latex.el" "org/ob-ledger.el"
-;;;;;; "org/ob-lilypond.el" "org/ob-lisp.el" "org/ob-lob.el" "org/ob-makefile.el"
-;;;;;; "org/ob-matlab.el" "org/ob-maxima.el" "org/ob-mscgen.el"
-;;;;;; "org/ob-ocaml.el" "org/ob-octave.el" "org/ob-org.el" "org/ob-perl.el"
-;;;;;; "org/ob-picolisp.el" "org/ob-plantuml.el" "org/ob-python.el"
-;;;;;; "org/ob-ref.el" "org/ob-ruby.el" "org/ob-sass.el" "org/ob-scala.el"
-;;;;;; "org/ob-scheme.el" "org/ob-screen.el" "org/ob-sh.el" "org/ob-shen.el"
-;;;;;; "org/ob-sql.el" "org/ob-sqlite.el" "org/ob-table.el" "org/ob-tangle.el"
-;;;;;; "org/ob.el" "org/org-archive.el" "org/org-attach.el" "org/org-bbdb.el"
-;;;;;; "org/org-bibtex.el" "org/org-clock.el" "org/org-crypt.el"
-;;;;;; "org/org-ctags.el" "org/org-datetree.el" "org/org-docview.el"
-;;;;;; "org/org-element.el" "org/org-entities.el" "org/org-eshell.el"
-;;;;;; "org/org-faces.el" "org/org-feed.el" "org/org-footnote.el"
-;;;;;; "org/org-gnus.el" "org/org-habit.el" "org/org-id.el" "org/org-indent.el"
-;;;;;; "org/org-info.el" "org/org-inlinetask.el" "org/org-install.el"
-;;;;;; "org/org-irc.el" "org/org-list.el" "org/org-macro.el" "org/org-mhe.el"
-;;;;;; "org/org-mobile.el" "org/org-mouse.el" "org/org-pcomplete.el"
-;;;;;; "org/org-plot.el" "org/org-protocol.el" "org/org-rmail.el"
-;;;;;; "org/org-src.el" "org/org-table.el" "org/org-timer.el" "org/org-w3m.el"
-;;;;;; "org/ox-ascii.el" "org/ox-beamer.el" "org/ox-html.el" "org/ox-icalendar.el"
-;;;;;; "org/ox-latex.el" "org/ox-man.el" "org/ox-md.el" "org/ox-odt.el"
-;;;;;; "org/ox-org.el" "org/ox-publish.el" "org/ox-texinfo.el" "org/ox.el"
-;;;;;; "play/gametree.el" "progmodes/ada-prj.el" "progmodes/cc-align.el"
+;;;;;; "net/nsm.el" "net/rfc2104.el" "net/sasl-cram.el" "net/sasl-digest.el"
+;;;;;; "net/sasl-scram-rfc.el" "net/sasl.el" "net/shr-color.el"
+;;;;;; "net/soap-client.el" "net/soap-inspect.el" "net/socks.el"
+;;;;;; "net/tls.el" "net/tramp-adb.el" "net/tramp-cache.el" "net/tramp-cmds.el"
+;;;;;; "net/tramp-compat.el" "net/tramp-gvfs.el" "net/tramp-gw.el"
+;;;;;; "net/tramp-loaddefs.el" "net/tramp-sh.el" "net/tramp-smb.el"
+;;;;;; "net/tramp-uu.el" "net/trampver.el" "net/zeroconf.el" "notifications.el"
+;;;;;; "nxml/nxml-enc.el" "nxml/nxml-maint.el" "nxml/nxml-ns.el"
+;;;;;; "nxml/nxml-outln.el" "nxml/nxml-parse.el" "nxml/nxml-rap.el"
+;;;;;; "nxml/nxml-util.el" "nxml/rng-dt.el" "nxml/rng-loc.el" "nxml/rng-maint.el"
+;;;;;; "nxml/rng-match.el" "nxml/rng-parse.el" "nxml/rng-pttrn.el"
+;;;;;; "nxml/rng-uri.el" "nxml/rng-util.el" "nxml/xsd-regexp.el"
+;;;;;; "org/ob-C.el" "org/ob-R.el" "org/ob-asymptote.el" "org/ob-awk.el"
+;;;;;; "org/ob-calc.el" "org/ob-clojure.el" "org/ob-comint.el" "org/ob-core.el"
+;;;;;; "org/ob-css.el" "org/ob-ditaa.el" "org/ob-dot.el" "org/ob-emacs-lisp.el"
+;;;;;; "org/ob-eval.el" "org/ob-exp.el" "org/ob-fortran.el" "org/ob-gnuplot.el"
+;;;;;; "org/ob-haskell.el" "org/ob-io.el" "org/ob-java.el" "org/ob-js.el"
+;;;;;; "org/ob-keys.el" "org/ob-latex.el" "org/ob-ledger.el" "org/ob-lilypond.el"
+;;;;;; "org/ob-lisp.el" "org/ob-lob.el" "org/ob-makefile.el" "org/ob-matlab.el"
+;;;;;; "org/ob-maxima.el" "org/ob-mscgen.el" "org/ob-ocaml.el" "org/ob-octave.el"
+;;;;;; "org/ob-org.el" "org/ob-perl.el" "org/ob-picolisp.el" "org/ob-plantuml.el"
+;;;;;; "org/ob-python.el" "org/ob-ref.el" "org/ob-ruby.el" "org/ob-sass.el"
+;;;;;; "org/ob-scala.el" "org/ob-scheme.el" "org/ob-screen.el" "org/ob-sh.el"
+;;;;;; "org/ob-shen.el" "org/ob-sql.el" "org/ob-sqlite.el" "org/ob-table.el"
+;;;;;; "org/ob-tangle.el" "org/ob.el" "org/org-archive.el" "org/org-attach.el"
+;;;;;; "org/org-bbdb.el" "org/org-bibtex.el" "org/org-clock.el"
+;;;;;; "org/org-crypt.el" "org/org-ctags.el" "org/org-datetree.el"
+;;;;;; "org/org-docview.el" "org/org-element.el" "org/org-entities.el"
+;;;;;; "org/org-eshell.el" "org/org-faces.el" "org/org-feed.el"
+;;;;;; "org/org-footnote.el" "org/org-gnus.el" "org/org-habit.el"
+;;;;;; "org/org-id.el" "org/org-indent.el" "org/org-info.el" "org/org-inlinetask.el"
+;;;;;; "org/org-install.el" "org/org-irc.el" "org/org-list.el" "org/org-loaddefs.el"
+;;;;;; "org/org-macro.el" "org/org-mhe.el" "org/org-mobile.el" "org/org-mouse.el"
+;;;;;; "org/org-pcomplete.el" "org/org-plot.el" "org/org-protocol.el"
+;;;;;; "org/org-rmail.el" "org/org-src.el" "org/org-table.el" "org/org-timer.el"
+;;;;;; "org/org-w3m.el" "org/ox-ascii.el" "org/ox-beamer.el" "org/ox-html.el"
+;;;;;; "org/ox-icalendar.el" "org/ox-latex.el" "org/ox-man.el" "org/ox-md.el"
+;;;;;; "org/ox-odt.el" "org/ox-org.el" "org/ox-publish.el" "org/ox-texinfo.el"
+;;;;;; "org/ox.el" "play/gametree.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"
;;;;;; "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"
;;;;;; "vc/vc-filewise.el" "vcursor.el" "vt-control.el" "vt100-led.el"
-;;;;;; "w32-fns.el" "w32-vars.el" "x-dnd.el") (21710 3276 42011
-;;;;;; 943000))
+;;;;;; "w32-fns.el" "w32-vars.el" "x-dnd.el") (21787 50860 126301
+;;;;;; 167000))
;;;***
\f
(aset hangul-queue i 0))
(if (notzerop (apply '+ (append hangul-queue nil)))
(hangul-insert-character hangul-queue)
- (delete-backward-char 1)))
+ (delete-char -1)))
(defun hangul-to-hanja-conversion ()
"Convert the previous hangul character to the corresponding hanja character.
(if (and (overlayp quail-overlay) (overlay-start quail-overlay))
(progn
(setq hanja-character (hangul-to-hanja-char (preceding-char)))
- (setq delete-func (lambda () (delete-backward-char 1))))
+ (setq delete-func (lambda () (delete-char -1))))
(setq hanja-character (hangul-to-hanja-char (following-char)))
(setq delete-func (lambda () (delete-char 1))))
(when hanja-character
;;;***
\f
-;;;### (autoloads nil "rmailmm" "rmailmm.el" "43e0b9f680c4d2581640b286bd4b3107")
+;;;### (autoloads nil "rmailmm" "rmailmm.el" "a17df5ef8968113c8f6a78cf85c82da4")
;;; Generated autoloads from rmailmm.el
(autoload 'rmail-mime "rmailmm" "\
;;;***
\f
-;;;### (autoloads nil "rmailsum" "rmailsum.el" "e3943ef45946f10b9b5cab8097d7f271")
+;;;### (autoloads nil "rmailsum" "rmailsum.el" "3203e61425330fc20f3154b559f8b539")
;;; Generated autoloads from rmailsum.el
(autoload 'rmail-summary "rmailsum" "\
(transfer-encoding (rmail-mime-entity-transfer-encoding entity))
(charset (cdr (assq 'charset (cdr (rmail-mime-entity-type entity)))))
(buffer (current-buffer))
+ (case-fold-search t)
coding-system)
(if charset (setq coding-system (coding-system-from-name charset)))
(or (and coding-system (coding-system-p coding-system))
(ignore-errors (base64-decode-region (point-min) (point-max))))
((string= transfer-encoding "quoted-printable")
(quoted-printable-decode-region (point-min) (point-max))))
+ ;; Some broken MUAs state the charset only in the HTML <head>,
+ ;; so if we don't have a non-trivial coding-system at this
+ ;; point, make one last attempt to find it there.
+ (if (eq coding-system 'undecided)
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward
+ "^<html><head><meta[^;]*; charset=\\([-a-zA-Z0-9]+\\)"
+ nil t)
+ (setq coding-system (coding-system-from-name (match-string 1)))
+ (or (and coding-system (coding-system-p coding-system))
+ (setq coding-system 'undecided)))
+ ;; Finally, let them manually force decoding if they know it.
+ (if (and (eq coding-system 'undecided)
+ (not (null coding-system-for-read)))
+ (setq coding-system coding-system-for-read))))
(decode-coding-region (point-min) (point) coding-system)
(if (and
(or (not rmail-mime-coding-system) (consp rmail-mime-coding-system))
;;; rmailsum.el --- make summary buffers for the mail reader
-;; Copyright (C) 1985, 1993-1996, 2000-2015 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1985, 1993-1996, 2000-2015 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
(forward-line 1)
(setq str (buffer-substring pos (1- (point))))
(while (looking-at "[ \t]")
- (setq str (concat str " "
+ (setq str (concat str " "
(buffer-substring (match-end 0)
(line-end-position))))
(forward-line 1))
(defun rmail-summary-next-all (&optional number)
(interactive "p")
- (forward-line (if number number 1))
+ (or number (setq number 1))
+ (forward-line number)
;; It doesn't look nice to move forward past the last message line.
(and (eobp) (> number 0)
(forward-line -1))
(defun rmail-summary-previous-all (&optional number)
(interactive "p")
- (forward-line (- (if number number 1)))
- ;; It doesn't look nice to move forward past the last message line.
- (and (eobp) (< number 0)
- (forward-line -1))
- (display-buffer rmail-buffer))
+ (rmail-summary-next-all (- (or number 1))))
(defun rmail-summary-next-msg (&optional number)
"Display next non-deleted msg from rmail file.
With optional prefix argument NUMBER, moves forward this number of non-deleted
messages, or backward if NUMBER is negative."
(interactive "p")
+ (or number (setq number 1))
(forward-line 0)
(and (> number 0) (end-of-line))
(let ((count (if (< number 0) (- number) number))
With optional prefix argument NUMBER, moves backward this number of
non-deleted messages."
(interactive "p")
- (rmail-summary-next-msg (- (if number number 1))))
+ (rmail-summary-next-msg (- (or number 1))))
(defun rmail-summary-next-labeled-message (n labels)
"Show next message with LABELS. Defaults to last labels used.
(error "Sending...failed to %s"
(buffer-substring (point-min) (point-max)))))))
(kill-buffer tembuf)
- (if (and (bufferp errbuf)
- (not error))
- (kill-buffer errbuf)
- (switch-to-buffer-other-window errbuf)))))
+ (when (buffer-live-p errbuf)
+ (if error
+ (switch-to-buffer-other-window errbuf)
+ (kill-buffer errbuf))))))
(autoload 'rmail-output-to-rmail-buffer "rmailout")
(frame-visible-p menu-frame))))
(defun menu-bar-non-minibuffer-window-p ()
- "Return non-nil if selected window of the menu frame is not a minibuf window.
-
-See the documentation of `menu-bar-menu-frame-live-and-visible-p'
-for the definition of the menu frame."
+ "Return non-nil if the menu frame's selected window is no minibuffer window.
+Return nil if the menu frame is dead or its selected window is a
+minibuffer window. The menu frame is the frame for which we are
+updating the menu."
(let ((menu-frame (or menu-updating-frame (selected-frame))))
- (not (window-minibuffer-p (frame-selected-window menu-frame)))))
+ (and (frame-live-p menu-frame)
+ (not (window-minibuffer-p
+ (frame-selected-window menu-frame))))))
(defun kill-this-buffer () ; for the menu bar
"Kill the current buffer.
(let ((buffers (buffer-list))
(frames (frame-list))
buffers-menu)
- ;; If requested, list only the N most recently selected buffers.
- (if (and (integerp buffers-menu-max-size)
- (> buffers-menu-max-size 1))
- (if (> (length buffers) buffers-menu-max-size)
- (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
;; Make the menu of buffers proper.
(setq buffers-menu
- (let (alist)
+ (let ((i 0)
+ (limit (if (and (integerp buffers-menu-max-size)
+ (> buffers-menu-max-size 1))
+ buffers-menu-max-size most-positive-fixnum))
+ alist)
;; Put into each element of buffer-list
;; the name for actual display,
;; perhaps truncated in the middle.
- (dolist (buf buffers)
- (let ((name (buffer-name buf)))
+ (while buffers
+ (let* ((buf (pop buffers))
+ (name (buffer-name buf)))
(unless (eq ?\s (aref name 0))
(push (menu-bar-update-buffers-1
(cons buf
name (- (/ buffers-menu-buffer-name-length 2))))
name)
))
- alist))))
+ alist)
+ ;; If requested, list only the N most recently
+ ;; selected buffers.
+ (when (= limit (setq i (1+ i)))
+ (setq buffers nil)))))
(list (menu-bar-buffer-vector alist))))
;; Make a Frames menu if we have more than one frame.
(ido-ignore-item-temp-list bufs))
(while (not (string-equal
(setq buf (read-buffer
- (if (eq read-buffer-function 'ido-read-buffer)
+ (if (eq read-buffer-function #'ido-read-buffer)
"Next buffer to search (C-j to end): "
"Next buffer to search (RET to end): ")
nil t))
(goto-char (if isearch-forward (point-min) (point-max)))
(isearch-forward-regexp nil t)))
+(defvar unload-function-defs-list)
+
(defun multi-isearch-unload-function ()
"Remove autoloaded variables from `unload-function-defs-list'.
Also prevent the feature from being reloaded via `isearch-mode-hook'."
`(menu-item "" ,(lambda () (interactive) (funcall exitfun))
:filter ,(lambda (cmd) (if dragged cmd)))))
;; Some of the events will of course end up looked up
- ;; with a mode-line or header-line prefix ...
+ ;; with a mode-line, header-line or vertical-line prefix ...
(define-key map [mode-line] map)
(define-key map [header-line] map)
+ (define-key map [vertical-line] map)
;; ... and some maybe even with a right- or bottom-divider
;; prefix.
(define-key map [right-divider] map)
(declare-function buffer-face-mode-invoke "face-remap"
(face arg &optional interactive))
(declare-function font-face-attributes "font.c" (font &optional frame))
+(defvar w32-use-w32-font-dialog)
+(defvar w32-fixed-font-alist)
(defun mouse-appearance-menu (event)
"Show a menu for changing the default face in the current buffer."
(define-key mouse-appearance-menu-map [text-scale-increase]
'(menu-item "Increase Buffer Text Size" text-scale-increase))
;; Font selector
- (if (functionp 'x-select-font)
+ (if (and (functionp 'x-select-font)
+ (or (not (boundp 'w32-use-w32-font-dialog))
+ w32-use-w32-font-dialog))
(define-key mouse-appearance-menu-map [x-select-font]
'(menu-item "Change Buffer Font..." x-select-font))
;; If the select-font is unavailable, construct a menu.
(let ((font-submenu (make-sparse-keymap "Change Text Font"))
- (font-alist (cdr (append x-fixed-font-alist
- (list (generate-fontset-menu))))))
+ (font-alist (cdr (append
+ (if (eq system-type 'windows-nt)
+ w32-fixed-font-alist
+ x-fixed-font-alist)
+ (list (generate-fontset-menu))))))
(dolist (family font-alist)
(let* ((submenu-name (car family))
(submenu-map (make-sparse-keymap submenu-name)))
;; different methods of remote control so there is one function for
;; each supported browser. If the chosen browser is not running, it
;; is started. Currently there is support for the following browsers,
-;; some of them probably now obsolete:
+;; as well as some other obsolete ones:
;; Function Browser Earliest version
;; browse-url-mozilla Mozilla Don't know
;; browse-url-firefox Firefox Don't know (tried with 1.0.1)
;; browse-url-chromium Chromium 3.0
-;; browse-url-galeon Galeon Don't know
;; browse-url-epiphany Epiphany Don't know
-;; browse-url-netscape Netscape 1.1b1
-;; browse-url-mosaic XMosaic/mMosaic <= 2.4
-;; browse-url-cci XMosaic 2.5
+;; browse-url-conkeror Conkeror Don't know
;; browse-url-w3 w3 0
-;; browse-url-w3-gnudoit w3 remotely
;; browse-url-text-* Any text browser 0
;; browse-url-generic arbitrary
;; browse-url-default-windows-browser MS-Windows browser
;; browse-url-default-macosx-browser Mac OS X browser
;; browse-url-xdg-open Free Desktop xdg-open on Gnome, KDE, Xfce4, LXDE
-;; browse-url-gnome-moz GNOME interface to Mozilla
;; browse-url-kde KDE konqueror (kfm)
;; browse-url-elinks Elinks Don't know (tried with 0.12.GIT)
-;; [A version of the Netscape browser is now free software
-;; <URL:http://www.mozilla.org/>, albeit not GPLed, so it is
-;; reasonable to have that as the default.]
-
-;; Note that versions of Netscape before 1.1b1 did not have remote
-;; control. <URL:http://www.netscape.com/newsref/std/x-remote.html>.
-
;; Browsers can cache Web pages so it may be necessary to tell them to
-;; reload the current page if it has changed (e.g. if you have edited
+;; reload the current page if it has changed (e.g., if you have edited
;; it). There is currently no perfect automatic solution to this.
-;; Netscape allows you to specify the id of the window you want to
-;; control but which window DO you want to control and how do you
-;; discover its id?
-
-;; William M. Perry's excellent "w3" WWW browser for
-;; Emacs <URL:ftp://cs.indiana.edu/pub/elisp/w3/>
-;; has a function w3-follow-url-at-point, but that
-;; doesn't let you edit the URL like browse-url.
-;; The `gnuserv' package that can be used to control it in another
-;; Emacs process is available from
-;; <URL:ftp://ftp.splode.com/pub/users/friedman/packages/>.
-
-;; Lynx is now distributed by the FSF. See also
-;; <URL:http://lynx.browser.org/>.
-
-;; Free graphical browsers that could be used by `browse-url-generic'
-;; include Chimera <URL:ftp://ftp.cs.unlv.edu/pub/chimera> and
-;; <URL:http://www.unlv.edu/chimera/>, Arena
-;; <URL:ftp://ftp.yggdrasil.com/pub/dist/web/arena> and Amaya
-;; <URL:ftp://ftp.w3.org/pub/amaya>. mMosaic
-;; <URL:ftp://ftp.enst.fr/pub/mbone/mMosaic/>,
-;; <URL:http://www.enst.fr/~dauphin/mMosaic/> (with development
-;; support for Java applets and multicast) can be used like Mosaic by
-;; setting `browse-url-mosaic-program' appropriately.
-
-;; I [Denis Howe, not Dave Love] recommend Nelson Minar
-;; <nelson@santafe.edu>'s excellent html-helper-mode.el for editing
-;; HTML and thank Nelson for his many useful comments on this code.
-;; <URL:http://www.santafe.edu/%7Enelson/hhm-beta/>
-
-;; See also hm--html-menus <URL:http://www.tnt.uni-hannover.de/%7Emuenkel/
-;; software/own/hm--html-menus/>. For composing correct HTML see also
-;; PSGML the general SGML structure editor package
-;; <URL:ftp://ftp.lysator.liu.se/pub/sgml>; hm--html-menus can be used
-;; with this.
-
;; This package generalizes function html-previewer-process in Marc
;; Andreessen's html-mode (LCD modes/html-mode.el.Z). See also the
;; ffap.el package. The huge hyperbole package also contains similar
;; functions.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Help!
-
-;; Can you write and test some code for the Macintrash and Windoze
-;; Netscape remote control APIs? (See the URL above).
-
-;; Do any other browsers have remote control?
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Usage
;; To always save modified buffers before displaying the file in a browser:
;; (setq browse-url-save-file t)
-;; To get round the Netscape caching problem, you could EITHER have
-;; write-file in html-helper-mode make Netscape reload the document:
-;;
-;; (autoload 'browse-url-netscape-reload "browse-url"
-;; "Ask a WWW browser to redisplay the current file." t)
-;; (add-hook 'html-helper-mode-hook
-;; (lambda ()
-;; (add-hook 'local-write-file-hooks
-;; (lambda ()
-;; (let ((local-write-file-hooks))
-;; (save-buffer))
-;; (browse-url-netscape-reload)
-;; t) ; => file written by hook
-;; t))) ; append to l-w-f-hooks
-;;
-;; OR have browse-url-of-file ask Netscape to load and then reload the
-;; file:
-;;
-;; (add-hook 'browse-url-of-file-hook 'browse-url-netscape-reload)
-
-;; You may also want to customize browse-url-netscape-arguments, e.g.
-;; (setq browse-url-netscape-arguments '("-install"))
-;;
-;; or similarly for the other browsers.
-
;; To invoke different browsers for different URLs:
;; (setq browse-url-browser-function '(("^mailto:" . browse-url-mail)
-;; ("." . browse-url-netscape)))
+;; ("." . browse-url-firefox)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Code:
regexp should probably be \".\" to specify a default browser."
:type '(choice
(function-item :tag "Emacs W3" :value browse-url-w3)
- (function-item :tag "W3 in another Emacs via `gnudoit'"
- :value browse-url-w3-gnudoit)
(function-item :tag "eww" :value eww-browse-url)
(function-item :tag "Mozilla" :value browse-url-mozilla)
(function-item :tag "Firefox" :value browse-url-firefox)
(function-item :tag "Chromium" :value browse-url-chromium)
- (function-item :tag "Galeon" :value browse-url-galeon)
(function-item :tag "Epiphany" :value browse-url-epiphany)
- (function-item :tag "Netscape" :value browse-url-netscape)
- (function-item :tag "Mosaic" :value browse-url-mosaic)
- (function-item :tag "Mosaic using CCI" :value browse-url-cci)
+ (function-item :tag "Conkeror" :value browse-url-conkeror)
(function-item :tag "Text browser in an xterm window"
:value browse-url-text-xterm)
(function-item :tag "Text browser in an Emacs window"
:value browse-url-default-windows-browser)
(function-item :tag "Default Mac OS X browser"
:value browse-url-default-macosx-browser)
- (function-item :tag "GNOME invoking Mozilla"
- :value browse-url-gnome-moz)
(function-item :tag "Default browser"
:value browse-url-default-browser)
(function :tag "Your own function")
:type 'string
:group 'browse-url)
+(make-obsolete-variable 'browse-url-netscape-program nil "25.1")
+
(defcustom browse-url-netscape-arguments nil
"A list of strings to pass to Netscape as arguments."
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(make-obsolete-variable 'browse-url-netscape-arguments nil "25.1")
+
(defcustom browse-url-netscape-startup-arguments browse-url-netscape-arguments
"A list of strings to pass to Netscape when it starts up.
Defaults to the value of `browse-url-netscape-arguments' at the time
`browse-url' is loaded."
:type '(repeat (string :tag "Argument"))
+
:group 'browse-url)
+(make-obsolete-variable 'browse-url-netscape-startup-arguments nil "25.1")
+
(defcustom browse-url-browser-display nil
"The X display for running the browser, if not same as Emacs's."
:type '(choice string (const :tag "Default" nil))
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(make-obsolete-variable 'browse-url-firefox-startup-arguments
+ "it no longer has any effect." "24.5")
+
(defcustom browse-url-chromium-program
(let ((candidates '("chromium" "chromium-browser")))
(while (and candidates (not (executable-find (car candidates))))
:type 'string
:group 'browse-url)
+(make-obsolete-variable 'browse-url-galeon-program nil "25.1")
+
(defcustom browse-url-galeon-arguments nil
"A list of strings to pass to Galeon as arguments."
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(make-obsolete-variable 'browse-url-galeon-arguments nil "25.1")
+
(defcustom browse-url-galeon-startup-arguments browse-url-galeon-arguments
"A list of strings to pass to Galeon when it starts up.
Defaults to the value of `browse-url-galeon-arguments' at the time
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(make-obsolete-variable 'browse-url-galeon-startup-arguments nil "25.1")
+
(defcustom browse-url-epiphany-program "epiphany"
"The name by which to invoke Epiphany."
:type 'string
;; GNOME means of invoking either Mozilla or Netscape.
(defvar browse-url-gnome-moz-program "gnome-moz-remote")
+(make-obsolete-variable 'browse-url-gnome-moz-program nil "25.1")
+
(defcustom browse-url-gnome-moz-arguments '()
"A list of strings passed to the GNOME mozilla viewer as arguments."
:version "21.1"
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(make-obsolete-variable 'browse-url-gnome-moz-arguments nil "25.1")
+
(defcustom browse-url-mozilla-new-window-is-tab nil
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
:type 'boolean
:group 'browse-url)
+(defcustom browse-url-conkeror-new-window-is-buffer nil
+ "Whether to open up new windows in a buffer or a new window.
+If non-nil, then open the URL in a new buffer rather than a new window if
+`browse-url-conkeror' is asked to open it in a new window."
+ :type 'boolean
+ :group 'browse-url)
+
(defcustom browse-url-galeon-new-window-is-tab nil
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
:type 'boolean
:group 'browse-url)
+(make-obsolete-variable 'browse-url-galeon-new-window-is-tab nil "25.1")
+
(defcustom browse-url-epiphany-new-window-is-tab nil
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
:type 'boolean
:group 'browse-url)
+(make-obsolete-variable 'browse-url-netscape-new-window-is-tab nil "25.1")
+
(defcustom browse-url-new-window-flag nil
"Non-nil means always open a new browser window with appropriate browsers.
Passing an interactive argument to \\[browse-url], or specific browser
-commands reverses the effect of this variable. Requires Netscape version
-1.1N or later or XMosaic version 2.5 or later if using those browsers."
+commands reverses the effect of this variable."
:type 'boolean
:group 'browse-url)
:version "20.3"
:group 'browse-url)
+(make-obsolete-variable 'browse-url-mosaic-program nil "25.1")
+
(defcustom browse-url-mosaic-arguments nil
"A list of strings to pass to Mosaic as arguments."
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(make-obsolete-variable 'browse-url-mosaic-arguments nil "25.1")
+
(defcustom browse-url-mosaic-pidfile "~/.mosaicpid"
"The name of the pidfile created by Mosaic."
:type 'string
:group 'browse-url)
+(make-obsolete-variable 'browse-url-mosaic-pidfile nil "25.1")
+
+(defcustom browse-url-conkeror-program "conkeror"
+ "The name by which to invoke Conkeror."
+ :type 'string
+ :version "25.1"
+ :group 'browse-url)
+
+(defcustom browse-url-conkeror-arguments nil
+ "A list of strings to pass to Conkeror as arguments."
+ :type '(repeat (string :tag "Argument"))
+ :group 'browse-url)
+
(defcustom browse-url-filename-alist
`(("^/\\(ftp@\\|anonymous@\\)?\\([^:]+\\):/*" . "ftp://\\2/")
;; The above loses the username to avoid the browser prompting for
:group 'browse-url)
(defcustom browse-url-of-file-hook nil
- "Run after `browse-url-of-file' has asked a browser to load a file.
-
-Set this to `browse-url-netscape-reload' to force Netscape to load the
-file rather than displaying a cached copy."
+ "Hook run after `browse-url-of-file' has asked a browser to load a file."
:type 'hook
- :options '(browse-url-netscape-reload)
:group 'browse-url)
(defcustom browse-url-CCI-port 3003
:type 'integer
:group 'browse-url)
+(make-obsolete-variable 'browse-url-CCI-port nil "25.1")
+
(defcustom browse-url-CCI-host "localhost"
"Host to access XMosaic via CCI.
This should be the host name of the machine running XMosaic with CCI
:type 'string
:group 'browse-url)
+(make-obsolete-variable 'browse-url-CCI-host nil "25.1")
+
(defvar browse-url-temp-file-name nil)
(make-variable-buffer-local 'browse-url-temp-file-name)
:type 'number
:group 'browse-url)
+(make-obsolete-variable 'browse-url-netscape-version nil "25.1")
+
(defcustom browse-url-text-browser "lynx"
"The name of the text browser to invoke."
:type 'string
;; functions allows them to be stand-alone commands, making it easier
;; to switch between browsers.
-(defun browse-url-interactive-arg (prompt &optional default-url)
+(defun browse-url-interactive-arg (prompt)
"Read a URL from the minibuffer, prompting with PROMPT.
If `transient-mark-mode' is non-nil and the mark is active,
it defaults to the current region, else to the URL at or before
"[\t\r\f\n ]+" ""
(buffer-substring-no-properties
(region-beginning) (region-end))))
- (browse-url-url-at-point)
- default-url))
+ (browse-url-url-at-point)))
(not (eq (null browse-url-new-window-flag)
(null current-prefix-arg)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Browser-independent commands
-(defun url-tidy (url)
- "Tidy up URL as much as possible."
- (if (equal 0 (string-match ".*://" url))
- url
- (concat "http://" url) ;;TODO guess more url forms, like mailto
- ))
-
;; A generic command to call the current browse-url-browser-function
;;;###autoload
(defun browse-url (url &rest args)
"Ask a WWW browser to load URL.
-Prompts for a URL, defaulting to the URL at or before point. Variable
+Prompt for a URL, defaulting to the URL at or before point. Variable
`browse-url-browser-function' says which browser to use.
If the URL is a mailto: URL, consult `browse-url-mailto-function'
first, if that exists."
(interactive (browse-url-interactive-arg "URL: "))
(unless (called-interactively-p 'interactive)
(setq args (or args (list browse-url-new-window-flag))))
- (setq url (url-tidy url))
(when (and url-handler-mode (not (file-name-absolute-p url)))
(setq url (expand-file-name url)))
(let ((process-environment (copy-sequence process-environment))
;;;###autoload
(defun browse-url-at-point (&optional arg)
"Ask a WWW browser to load the URL at or before point.
-Doesn't let you edit the URL like `browse-url'. Variable
-`browse-url-browser-function' says which browser to use."
+Variable `browse-url-browser-function' says which browser to use."
(interactive "P")
(let ((url (browse-url-url-at-point)))
(if url
(defun browse-url-at-mouse (event)
"Ask a WWW browser to load a URL clicked with the mouse.
The URL is the one around or before the position of the mouse click
-but point is not changed. Doesn't let you edit the URL like
-`browse-url'. Variable `browse-url-browser-function' says which browser
-to use."
+but point is not changed. Variable `browse-url-browser-function'
+says which browser to use."
(interactive "e")
(save-excursion
(mouse-set-point event)
((memq system-type '(darwin))
'browse-url-default-macosx-browser)
((browse-url-can-use-xdg-open) 'browse-url-xdg-open)
- ((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz)
+;;; ((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz)
((executable-find browse-url-mozilla-program) 'browse-url-mozilla)
((executable-find browse-url-firefox-program) 'browse-url-firefox)
((executable-find browse-url-chromium-program) 'browse-url-chromium)
- ((executable-find browse-url-galeon-program) 'browse-url-galeon)
+;;; ((executable-find browse-url-galeon-program) 'browse-url-galeon)
((executable-find browse-url-kde-program) 'browse-url-kde)
- ((executable-find browse-url-netscape-program) 'browse-url-netscape)
- ((executable-find browse-url-mosaic-program) 'browse-url-mosaic)
+;;; ((executable-find browse-url-netscape-program) 'browse-url-netscape)
+;;; ((executable-find browse-url-mosaic-program) 'browse-url-mosaic)
+ ((executable-find browse-url-conkeror-program) 'browse-url-conkeror)
((executable-find browse-url-xterm-program) 'browse-url-text-xterm)
((locate-library "w3") 'browse-url-w3)
(t
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
+ (declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
(defun browse-url-netscape-sentinel (process url)
"Handle a change to the process communicating with Netscape."
+ (declare (obsolete nil "25.1"))
(or (eq (process-exit-status process) 0)
(let* ((process-environment (browse-url-process-environment)))
;; Netscape not running - start it
(defun browse-url-netscape-reload ()
"Ask Netscape to reload its current document.
How depends on `browse-url-netscape-version'."
+ (declare (obsolete nil "25.1"))
(interactive)
;; Backwards incompatibility reported by
;; <peter.kruse@psychologie.uni-regensburg.de>.
(defun browse-url-netscape-send (command)
"Send a remote control command to Netscape."
+ (declare (obsolete nil "25.1"))
(let* ((process-environment (browse-url-process-environment)))
(apply 'start-process "netscape" nil
browse-url-netscape-program
;;;###autoload
(defun browse-url-firefox (url &optional new-window)
"Ask the Firefox WWW browser to load URL.
-Default to the URL around or before point. The strings in
-variable `browse-url-firefox-arguments' are also passed to
-Firefox.
+Defaults to the URL around or before point. Passes the strings
+in the variable `browse-url-firefox-arguments' to Firefox.
-When called interactively, if variable
-`browse-url-new-window-flag' is non-nil, load the document in a
-new Firefox window, otherwise use a random existing one. A
-non-nil interactive prefix argument reverses the effect of
-`browse-url-new-window-flag'.
+Interactively, if the variable `browse-url-new-window-flag' is non-nil,
+loads the document in a new Firefox window. A non-nil prefix argument
+reverses the effect of `browse-url-new-window-flag'.
If `browse-url-firefox-new-window-is-tab' is non-nil, then
whenever a document would otherwise be loaded in a new window, it
is loaded in a new tab in an existing window instead.
-When called non-interactively, optional second argument
-NEW-WINDOW is used instead of `browse-url-new-window-flag'.
-
-On MS-Windows systems the optional `new-window' parameter is
-ignored. Firefox for Windows does not support the \"-remote\"
-command line parameter. Therefore, the
-`browse-url-new-window-flag' and `browse-url-firefox-new-window-is-tab'
-are ignored as well. Firefox on Windows will always open the requested
-URL in a new window."
+Non-interactively, this uses the optional second argument NEW-WINDOW
+instead of `browse-url-new-window-flag'."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
- (let* ((process-environment (browse-url-process-environment))
- (use-remote
- (not (memq system-type '(windows-nt ms-dos))))
- (process
- (apply 'start-process
- (concat "firefox " url) nil
- browse-url-firefox-program
- (append
- browse-url-firefox-arguments
- (if use-remote
- (list "-remote"
- (concat
- "openURL("
- url
- (if (browse-url-maybe-new-window new-window)
- (if browse-url-firefox-new-window-is-tab
- ",new-tab"
- ",new-window"))
- ")"))
- (list url))))))
- ;; If we use -remote, the process exits with status code 2 if
- ;; Firefox is not already running. The sentinel runs firefox
- ;; directly if that happens.
- (when use-remote
- (set-process-sentinel process
- `(lambda (process change)
- (browse-url-firefox-sentinel process ,url))))))
-
-(defun browse-url-firefox-sentinel (process url)
- "Handle a change to the process communicating with Firefox."
- (or (eq (process-exit-status process) 0)
- (let* ((process-environment (browse-url-process-environment)))
- ;; Firefox is not running - start it
- (message "Starting Firefox...")
- (apply 'start-process (concat "firefox " url) nil
- browse-url-firefox-program
- (append browse-url-firefox-startup-arguments (list url))))))
+ (let* ((process-environment (browse-url-process-environment)))
+ (apply 'start-process
+ (concat "firefox " url) nil
+ browse-url-firefox-program
+ (append
+ browse-url-firefox-arguments
+ (if (browse-url-maybe-new-window new-window)
+ (if browse-url-firefox-new-window-is-tab
+ '("-new-tab")
+ '("-new-window")))
+ (list url)))))
;;;###autoload
(defun browse-url-chromium (url &optional _new-window)
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
+ (declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
(defun browse-url-galeon-sentinel (process url)
"Handle a change to the process communicating with Galeon."
+ (declare (obsolete nil "25.1"))
(or (eq (process-exit-status process) 0)
(let* ((process-environment (browse-url-process-environment)))
;; Galeon is not running - start it
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
+ (declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "URL: "))
(apply 'start-process (concat "gnome-moz-remote " url)
nil
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
+ (declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "Mosaic URL: "))
(let ((pidfile (expand-file-name browse-url-mosaic-pidfile))
pid)
When called non-interactively, optional second argument NEW-WINDOW is
used instead of `browse-url-new-window-flag'."
+ (declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "Mosaic URL: "))
(open-network-stream "browse-url" " *browse-url*"
browse-url-CCI-host browse-url-CCI-port)
(process-send-string "browse-url" "disconnect\r\n")
(delete-process "browse-url"))
+;; --- Conkeror ---
+;;;###autoload
+(defun browse-url-conkeror (url &optional new-window)
+ "Ask the Conkeror WWW browser to load URL.
+Default to the URL around or before point. Also pass the strings
+in the variable `browse-url-conkeror-arguments' to Conkeror.
+
+When called interactively, if variable
+`browse-url-new-window-flag' is non-nil, load the document in a
+new Conkeror window, otherwise use a random existing one. A
+non-nil interactive prefix argument reverses the effect of
+`browse-url-new-window-flag'.
+
+If variable `browse-url-conkeror-new-window-is-buffer' is
+non-nil, then whenever a document would otherwise be loaded in a
+new window, load it in a new buffer in an existing window instead.
+
+When called non-interactively, use optional second argument
+NEW-WINDOW instead of `browse-url-new-window-flag'."
+ (interactive (browse-url-interactive-arg "URL: "))
+ (setq url (browse-url-encode-url url))
+ (let* ((process-environment (browse-url-process-environment)))
+ (apply 'start-process (format "conkeror %s" url)
+ nil
+ browse-url-conkeror-program
+ (append
+ browse-url-conkeror-arguments
+ (list
+ "-e"
+ (format "load_url_in_new_%s('%s')"
+ (if (browse-url-maybe-new-window new-window)
+ (if browse-url-conkeror-new-window-is-buffer
+ "buffer"
+ "window")
+ "buffer")
+ url))))))
;; --- W3 ---
;; External.
"Ask another Emacs running gnuserv to load the URL using the W3 browser.
The `browse-url-gnudoit-program' program is used with options given by
`browse-url-gnudoit-args'. Default to the URL around or before point."
+ (declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "W3 URL: "))
(apply 'start-process (concat "gnudoit:" url) nil
browse-url-gnudoit-program
(n browse-url-text-input-attempts))
(require 'term)
(if (and (browse-url-maybe-new-window new-buffer) buf)
- ;; Rename away the OLD buffer. This isn't very polite, but
+ ;; Rename away the OLD buffer. This isn't very polite, but
;; term insists on working in a buffer named *lynx* and would
;; choke on *lynx*<1>
(progn (set-buffer buf)
(setq counter (match-string 2 (symbol-name key))
args (cdr args)
value (car args))
- (unless (and (<= counter 63) (stringp value))
+ (unless (and (<= (string-to-number counter) 63)
+ (stringp value))
(signal 'wrong-type-argument
(list "Wrong argument" key value)))
(format
(defvar eudc-bbdb-current-query nil)
(defvar eudc-bbdb-current-return-attributes nil)
+(defvar bbdb-version)
+
+(defun eudc-bbdb-field (field-symbol)
+ "Convert FIELD-SYMBOL so that it is recognized by the current BBDB version.
+BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
+ ;; This just-in-time translation permits upgrading from BBDB 2 to
+ ;; BBDB 3 without restarting Emacs.
+ (if (and (eq field-symbol 'net)
+ (or
+ ;; MELPA versions of BBDB may have a bad package version,
+ ;; but they're all version 3 or later.
+ (equal bbdb-version "@PACKAGE_VERSION@")
+ ;; Development versions of BBDB can have the format "X.YZ
+ ;; devo". Split the string just in case.
+ (version<= "3" (car (split-string bbdb-version)))))
+ 'mail
+ field-symbol))
+
(defvar eudc-bbdb-attributes-translation-alist
'((name . lastname)
(email . net)
(progn
(setq bbdb-val
(eval (list (intern (concat "bbdb-record-"
- (symbol-name attr)))
+ (symbol-name
+ (eudc-bbdb-field
+ attr))))
'record)))
(if (listp bbdb-val)
(if eudc-bbdb-enable-substring-matches
(setq val (eval
(list (intern
(concat "bbdb-record-"
- (symbol-name attr)))
+ (symbol-name (eudc-bbdb-field attr))))
'record))))
(t
(error "Unknown BBDB attribute")))
(defun eudc-ldap-cleanup-record-simple (record)
"Do some cleanup in a RECORD to make it suitable for EUDC."
+ (declare (obsolete eudc-ldap-cleanup-record-filtering-addresses "25.1"))
(mapcar
(function
(lambda (field)
- ;; Some servers return case-sensitive names (e.g. givenName
- ;; instead of givenname); downcase the field's name so that it
- ;; can be matched against
- ;; eudc-ldap-attributes-translation-alist.
(cons (intern (downcase (car field)))
(if (cdr (cdr field))
(cdr field)
(defun eudc-filter-$ (string)
(mapconcat 'identity (split-string string "\\$") "\n"))
-;; Cleanup a LDAP record to make it suitable for EUDC:
-;; Make the record a cons-cell instead of a list if it is single-valued
-;; Filter the $ character in addresses into \n if not done by the LDAP lib
(defun eudc-ldap-cleanup-record-filtering-addresses (record)
- (mapcar
- (function
- (lambda (field)
+ "Clean up RECORD to make it suitable for EUDC.
+Make the record a cons-cell instead of a list if it is
+single-valued. Change the `$' character in postal addresses to a
+newline. Combine separate mail fields into one mail field with
+multiple addresses."
+ (let ((clean-up-addresses (or (not (boundp 'ldap-ignore-attribute-codings))
+ (not ldap-ignore-attribute-codings)))
+ result mail-addresses)
+ (dolist (field record)
+ ;; Some servers return case-sensitive names (e.g. givenName
+ ;; instead of givenname); downcase the field's name so that it
+ ;; can be matched against
+ ;; eudc-ldap-attributes-translation-alist.
(let ((name (intern (downcase (car field))))
(value (cdr field)))
- (if (memq name '(postaladdress registeredaddress))
- (setq value (mapcar 'eudc-filter-$ value)))
- (cons name
- (if (cdr value)
- value
- (car value))))))
- record))
+ (when (and clean-up-addresses
+ (memq name '(postaladdress registeredaddress)))
+ (setq value (mapcar 'eudc-filter-$ value)))
+ (if (eq name 'mail)
+ (setq mail-addresses (append mail-addresses value))
+ (push (cons name (if (cdr value)
+ value
+ (car value)))
+ result))))
+ (push (cons 'mail (if (cdr mail-addresses)
+ mail-addresses
+ (car mail-addresses)))
+ result)
+ (nreverse result)))
(defun eudc-ldap-simple-query-internal (query &optional return-attrs)
"Query the LDAP server with QUERY.
(if (listp return-attrs)
(mapcar 'symbol-name return-attrs))))
final-result)
- (if (or (not (boundp 'ldap-ignore-attribute-codings))
- ldap-ignore-attribute-codings)
- (setq result
- (mapcar 'eudc-ldap-cleanup-record-filtering-addresses result))
- (setq result (mapcar 'eudc-ldap-cleanup-record-simple result)))
+ (setq result (mapcar 'eudc-ldap-cleanup-record-filtering-addresses result))
(if (and eudc-strict-return-matches
return-attrs
(let ((ldap-host-parameters-alist
(list (cons eudc-server
'(scope subtree sizelimit 1)))))
- (mapcar 'eudc-ldap-cleanup-record-simple
+ (mapcar 'eudc-ldap-cleanup-record-filtering-addresses
(ldap-search
(eudc-ldap-format-query-as-rfc1558
(list (cons "objectclass"
:type 'string)
(defcustom eww-search-prefix "https://duckduckgo.com/html/?q="
- "Prefix URL to search engine"
+ "Prefix URL to search engine."
:version "24.4"
:group 'eww
:type 'string)
:group 'eww
:type 'string)
+;;;###autoload
(defcustom eww-suggest-uris
'(eww-links-at-point
url-get-url-at-point
(cond ((string-match-p "\\`file:/" url))
;; Don't mangle file: URLs at all.
((string-match-p "\\`ftp://" url)
- (user-error "FTP is not supported."))
+ (user-error "FTP is not supported"))
(t
;; Anything that starts with something that vaguely looks
;; like a protocol designator is interpreted as a full URL.
;;;###autoload
(defun eww-open-file (file)
- "Render a file using EWW."
+ "Render FILE using EWW."
(interactive "fFile: ")
(eww (concat "file://"
(and (memq system-type '(windows-nt ms-dos))
;;;###autoload
(defun eww-search-words (&optional beg end)
- "Search the web for the text between the point and marker.
+ "Search the web for the text between BEG and END.
See the `eww-search-prefix' variable for the search engine used."
(interactive "r")
(eww (buffer-substring beg end)))
+(defun eww-html-p (content-type)
+ "Return non-nil if CONTENT-TYPE designates an HTML content type.
+Currently this means either text/html or application/xhtml+xml."
+ (member content-type '("text/html"
+ "application/xhtml+xml")))
+
(defun eww-render (status url &optional point buffer encode)
(let ((redirect (plist-get status :redirect)))
(when redirect
(charset (intern
(downcase
(or (cdr (assq 'charset (cdr content-type)))
- (eww-detect-charset (equal (car content-type)
- "text/html"))
+ (eww-detect-charset (eww-html-p (car content-type)))
"utf-8"))))
(data-buffer (current-buffer)))
;; Save the https peer status.
(string-match-p eww-use-external-browser-for-content-type
(car content-type)))
(eww-browse-with-external-browser url))
- ((equal (car content-type) "text/html")
+ ((eww-html-p (car content-type))
(eww-display-html charset url nil point buffer encode))
((equal (car content-type) "application/pdf")
(eww-display-pdf))
(form . eww-tag-form)
(input . eww-tag-input)
(textarea . eww-tag-textarea)
- (body . eww-tag-body)
(select . eww-tag-select)
(link . eww-tag-link)
(a . eww-tag-a))))
(replace-regexp-in-string "[ \t\r\n]+" " " (dom-text dom))))
(eww-update-header-line-format))
-(defun eww-tag-body (dom)
- (let* ((start (point))
- (fgcolor (or (dom-attr dom 'fgcolor) (dom-attr dom 'text)))
- (bgcolor (dom-attr dom 'bgcolor))
- (shr-stylesheet (list (cons 'color fgcolor)
- (cons 'background-color bgcolor))))
- (shr-generic dom)
- (shr-colorize-region start (point) fgcolor bgcolor)))
-
(defun eww-display-raw (buffer &optional encode)
(let ((data (buffer-substring (point) (point-max))))
(unless (buffer-live-p buffer)
(define-key map "H" 'eww-list-histories)
(define-key map "E" 'eww-set-character-encoding)
(define-key map "S" 'eww-list-buffers)
+ (define-key map "F" 'eww-toggle-fonts)
(define-key map "b" 'eww-add-bookmark)
(define-key map "B" 'eww-list-bookmarks)
map)
"Tool bar for `eww-mode'.")
+;; Autoload cookie needed by desktop.el.
+;;;###autoload
(define-derived-mode eww-mode special-mode "eww"
"Mode for browsing the web."
(setq-local eww-data (list :title ""))
(eww-browse-url url external)))))
(defun eww-same-page-p (url1 url2)
- "Return non-nil if both URLs represent the same page.
+ "Return non-nil if URL1 and URL2 represent the same page.
Differences in #targets are ignored."
(let ((obj1 (url-generic-parse-url url1))
(obj2 (url-generic-parse-url url2)))
(expand-file-name file directory)))
(defun eww-set-character-encoding (charset)
- "Set character encoding."
+ "Set character encoding to CHARSET.
+If CHARSET is nil then use UTF-8."
(interactive "zUse character set (default utf-8): ")
(if (null charset)
(eww-reload nil 'utf-8)
(eww-reload nil charset)))
+(defun eww-toggle-fonts ()
+ "Toggle whether to use monospaced or font-enabled layouts."
+ (interactive)
+ (message "Fonts are now %s"
+ (if (setq shr-use-fonts (not shr-use-fonts))
+ "on"
+ "off"))
+ (eww-reload))
+
;;; Bookmarks code
(defvar eww-bookmarks nil)
(case eww-restore-desktop
((t auto) (eww (plist-get eww-data :url)))
((zerop (buffer-size))
- (insert (substitute-command-keys
- eww-restore-reload-prompt))))))
+ (let ((inhibit-read-only t))
+ (insert (substitute-command-keys
+ eww-restore-reload-prompt)))))))
;; .
(current-buffer)))
(houseidentifier . 15)
(supportedalgorithms . 49)
(deltarevocationlist . 9)
- (dmdname . 15))
+ (dmdname . 15)
+ (carlicense . 15)
+ (departmentnumber . 15)
+ (displayname . 15)
+ (employeenumber . 15)
+ (employeetype . 15)
+ (jpegphoto . 28)
+ (preferredlanguage . 15)
+ (usersmimecertificate . 5)
+ (userpkcs12 . 5))
"A map of LDAP attribute names to their type object id minor number.
-This table is built from RFC2252 Section 5 and RFC2256 Section 5")
+This table is built from RFC2252 Section 5, RFC2256 Section 5 and
+RFC2798 Section 9.1.1")
;; Coding/decoding functions
`auth' is one of the symbols `simple', `krbv41' or `krbv42'.
`base' is the base for the search as described in RFC 1779.
`scope' is one of the three symbols `sub', `base' or `one'.
- `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
- `auth' is one of the symbols `simple', `krbv41' or `krbv42'
+ `binddn' is the distinguished name of the user to bind as (in
+RFC 1779 syntax).
`passwd' is the password to use for simple authentication.
`deref' is one of the symbols `never', `always', `search' or `find'.
`timelimit' is the timeout limit for the connection in seconds.
(when (re-search-forward eoc nil t)
(goto-char (match-beginning 0))
(delete-region (point-min) (line-beginning-position))))
- (let* ((capability-command (plist-get parameters :capability-command)))
+ (let ((capability-command (plist-get parameters :capability-command))
+ (eo-capa (or (plist-get parameters :end-of-capability)
+ eoc)))
(list stream
(network-stream-get-response stream start eoc)
- (network-stream-command stream capability-command eoc)
+ (network-stream-command stream capability-command eo-capa)
'tls))))))
(defun network-stream-open-shell (name buffer host service parameters)
--- /dev/null
+;;; sasl-scram-rfc.el --- SCRAM-SHA-1 module for the SASL client framework -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Magnus Henoch <magnus.henoch@gmail.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/>.
+
+;;; Commentary:
+
+;; This program is implemented from RFC 5802. It implements the
+;; SCRAM-SHA-1 SASL mechanism.
+;;
+;; RFC 5802 foresees "hash agility", i.e. new mechanisms based on the
+;; same protocol but using a different hash function. Likewise, this
+;; module attempts to separate generic and specific functions, which
+;; should make it easy to implement any future SCRAM-* SASL mechanism.
+;; It should be as simple as copying the SCRAM-SHA-1 section below and
+;; replacing all SHA-1 references.
+;;
+;; This module does not yet implement the variants with channel
+;; binding, i.e. SCRAM-*-PLUS. That would require cooperation from
+;; the TLS library.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'sasl)
+(require 'hex-util)
+(require 'rfc2104)
+
+;;; Generic for SCRAM-*
+
+(defun sasl-scram-client-first-message (client _step)
+ (let ((c-nonce (sasl-unique-id)))
+ (sasl-client-set-property client 'c-nonce c-nonce))
+ (concat
+ ;; n = client doesn't support channel binding
+ "n,"
+ ;; TODO: where would we get authorization id from?
+ ","
+ (sasl-scram--client-first-message-bare client)))
+
+(defun sasl-scram--client-first-message-bare (client)
+ (let ((c-nonce (sasl-client-property client 'c-nonce)))
+ (concat
+ ;; TODO: saslprep username or disallow non-ASCII characters
+ "n=" (sasl-client-name client) ","
+ "r=" c-nonce)))
+
+(defun sasl-scram--client-final-message (hash-fun block-length hash-length client step)
+ (unless (string-match
+ "^r=\\([^,]+\\),s=\\([^,]+\\),i=\\([0-9]+\\)\\(?:$\\|,\\)"
+ (sasl-step-data step))
+ (sasl-error "Unexpected server response"))
+ (let* ((hmac-fun (lambda (text key)
+ (decode-hex-string
+ (rfc2104-hash hash-fun block-length hash-length key text))))
+ (step-data (sasl-step-data step))
+ (nonce (match-string 1 step-data))
+ (salt-base64 (match-string 2 step-data))
+ (iteration-count (string-to-number (match-string 3 step-data)))
+
+ (c-nonce (sasl-client-property client 'c-nonce))
+ ;; no channel binding, no authorization id
+ (cbind-input "n,,"))
+ (unless (string-prefix-p c-nonce nonce)
+ (sasl-error "Invalid nonce from server"))
+ (let* ((client-final-message-without-proof
+ (concat "c=" (base64-encode-string cbind-input) ","
+ "r=" nonce))
+ (password
+ ;; TODO: either apply saslprep or disallow non-ASCII characters
+ (sasl-read-passphrase
+ (format "%s passphrase for %s: "
+ (sasl-mechanism-name (sasl-client-mechanism client))
+ (sasl-client-name client))))
+ (salt (base64-decode-string salt-base64))
+ (salted-password
+ ;; Hi(str, salt, i):
+ (let ((digest (concat salt (string 0 0 0 1)))
+ (xored nil))
+ (dotimes (_i iteration-count xored)
+ (setq digest (funcall hmac-fun digest password))
+ (setq xored (if (null xored)
+ digest
+ (cl-map 'string 'logxor xored digest))))))
+ (client-key
+ (funcall hmac-fun "Client Key" salted-password))
+ (stored-key (decode-hex-string (funcall hash-fun client-key)))
+ (auth-message
+ (concat
+ (sasl-scram--client-first-message-bare client) ","
+ step-data ","
+ client-final-message-without-proof))
+ (client-signature (funcall hmac-fun (encode-coding-string auth-message 'utf-8) stored-key))
+ (client-proof (cl-map 'string 'logxor client-key client-signature))
+ (client-final-message
+ (concat client-final-message-without-proof ","
+ "p=" (base64-encode-string client-proof))))
+ (sasl-client-set-property client 'auth-message auth-message)
+ (sasl-client-set-property client 'salted-password salted-password)
+ client-final-message)))
+
+(defun sasl-scram--authenticate-server (hash-fun block-length hash-length client step)
+ (cond
+ ((string-match "^e=\\([^,]+\\)" (sasl-step-data step))
+ (sasl-error (format "Server error: %s" (match-string 1 (sasl-step-data step)))))
+ ((string-match "^v=\\([^,]+\\)" (sasl-step-data step))
+ (let* ((hmac-fun (lambda (text key)
+ (decode-hex-string
+ (rfc2104-hash hash-fun block-length hash-length key text))))
+ (verifier (base64-decode-string (match-string 1 (sasl-step-data step))))
+ (auth-message (sasl-client-property client 'auth-message))
+ (salted-password (sasl-client-property client 'salted-password))
+ (server-key (funcall hmac-fun "Server Key" salted-password))
+ (expected-server-signature
+ (funcall hmac-fun (encode-coding-string auth-message 'utf-8) server-key)))
+ (unless (string= expected-server-signature verifier)
+ (sasl-error "Server not authenticated"))))
+ (t
+ (sasl-error "Invalid response from server"))))
+
+;;; SCRAM-SHA-1
+
+(defconst sasl-scram-sha-1-steps
+ '(sasl-scram-client-first-message
+ sasl-scram-sha-1-client-final-message
+ sasl-scram-sha-1-authenticate-server))
+
+(defun sasl-scram-sha-1-client-final-message (client step)
+ (sasl-scram--client-final-message
+ ;; HMAC-SHA1 uses block length 64 and hash length 20; see RFC 2104.
+ 'sha1 64 20 client step))
+
+(defun sasl-scram-sha-1-authenticate-server (client step)
+ (sasl-scram--authenticate-server
+ 'sha1 64 20 client step))
+
+;; This needs to be at the end, because of how `sasl-make-mechanism'
+;; handles step function names.
+(put 'sasl-scram-sha-1 'sasl-mechanism
+ (sasl-make-mechanism "SCRAM-SHA-1" sasl-scram-sha-1-steps))
+
+(put 'sasl-scram-rfc 'sasl-mechanism (get 'sasl-scram-sha-1 'sasl-mechanism))
+
+(provide 'sasl-scram-sha-1)
+
+(provide 'sasl-scram-rfc)
+;;; sasl-scram-rfc.el ends here
;;; Code:
(defvar sasl-mechanisms
- '("CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"
- "NTLM" "SCRAM-MD5"))
+ '("SCRAM-SHA-1" "CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"
+ "NTLM"))
(defvar sasl-mechanism-alist
'(("CRAM-MD5" sasl-cram)
("LOGIN" sasl-login)
("ANONYMOUS" sasl-anonymous)
("NTLM" sasl-ntlm)
- ("SCRAM-MD5" sasl-scram)))
+ ("SCRAM-SHA-1" sasl-scram-rfc)))
(defvar sasl-unique-id-function #'sasl-unique-id-function)
:group 'shr
:type '(choice (const nil) regexp))
+(defcustom shr-use-fonts nil
+ "If non-nil, use proportional fonts for text."
+ :version "25.1"
+ :group 'shr
+ :type 'boolean)
+
(defcustom shr-table-horizontal-line nil
"Character used to draw horizontal table lines.
If nil, don't draw horizontal table lines."
;;; Internal variables.
(defvar shr-folding-mode nil)
-(defvar shr-state nil)
(defvar shr-start nil)
(defvar shr-indentation 0)
-(defvar shr-internal-width (or shr-width (1- (window-width))))
+(defvar shr-internal-width nil)
(defvar shr-list-mode nil)
(defvar shr-content-cache nil)
(defvar shr-kinsoku-shorten nil)
(defvar shr-target-id nil)
(defvar shr-inhibit-decoration nil)
(defvar shr-table-separator-length 1)
+(defvar shr-table-separator-pixel-width 0)
+(defvar shr-table-id nil)
+(defvar shr-current-font nil)
+(defvar shr-internal-bullet nil)
(defvar shr-map
(let ((map (make-sparse-keymap)))
`libxml-parse-html-region' or similar."
(setq shr-content-cache nil)
(let ((start (point))
- (shr-state nil)
(shr-start nil)
(shr-base nil)
(shr-depth 0)
+ (shr-table-id 0)
(shr-warning nil)
- (shr-internal-width (or shr-width (1- (window-width)))))
+ (shr-table-separator-pixel-width (shr-string-pixel-width "-"))
+ (shr-internal-bullet (cons shr-bullet
+ (shr-string-pixel-width shr-bullet)))
+ (shr-internal-width (or (and shr-width
+ (if (not shr-use-fonts)
+ shr-width
+ (* shr-width (frame-char-width))))
+ (if (not shr-use-fonts)
+ (- (window-width) 2)
+ (- (window-pixel-width)
+ (* (frame-fringe-width) 2))))))
(shr-descend dom)
+ (shr-fill-lines start (point))
(shr-remove-trailing-whitespace start (point))
(when shr-warning
(message "%s" shr-warning))))
(let ((text (get-text-property (point) 'shr-alt)))
(if (not text)
(message "No image under point")
- (message "%s" (shr-fold-text text)))))
+ (message "%s" (shr-fill-text text)))))
(defun shr-browse-image (&optional copy-url)
"Browse the image under point.
(cdr (assq 'color shr-stylesheet))
(cdr (assq 'background-color shr-stylesheet))))))))
-(defun shr-fold-text (text)
+(defun shr-fill-text (text)
(if (zerop (length text))
text
(with-temp-buffer
(let ((shr-indentation 0)
- (shr-state nil)
(shr-start nil)
- (shr-internal-width (window-width)))
+ (shr-internal-width (- (window-pixel-width)
+ (* (frame-fringe-width) 2))))
(shr-insert text)
(buffer-string)))))
(unless (shr-char-kinsoku-bol-p (make-char 'japanese-jisx0208 33 35))
(load "kinsoku" nil t))
+(defun shr-pixel-column ()
+ (if (not shr-use-fonts)
+ (current-column)
+ (if (not (get-buffer-window (current-buffer)))
+ (save-window-excursion
+ (set-window-buffer nil (current-buffer))
+ (car (window-text-pixel-size nil (line-beginning-position) (point))))
+ (car (window-text-pixel-size nil (line-beginning-position) (point))))))
+
+(defun shr-pixel-region ()
+ (- (shr-pixel-column)
+ (save-excursion
+ (goto-char (mark))
+ (shr-pixel-column))))
+
+(defun shr-string-pixel-width (string)
+ (if (not shr-use-fonts)
+ (length string)
+ (with-temp-buffer
+ (insert string)
+ (shr-pixel-column))))
+
(defun shr-insert (text)
- (when (and (eq shr-state 'image)
- (not (bolp))
- (not (string-match "\\`[ \t\n]+\\'" text)))
- (insert "\n")
- (setq shr-state nil))
+ (when (and (not (bolp))
+ (get-text-property (1- (point)) 'image-url))
+ (insert "\n"))
(cond
((eq shr-folding-mode 'none)
- (insert text))
+ (let ((start (point)))
+ (insert text)
+ (save-restriction
+ (narrow-to-region start (point))
+ ;; Remove soft hyphens.
+ (goto-char (point-min))
+ (while (search-forward "" nil t)
+ (replace-match "" t t))
+ (goto-char (point-max)))))
(t
- (when (and (string-match "\\`[ \t\n ]" text)
- (not (bolp))
- (not (eq (char-after (1- (point))) ? )))
- (insert " "))
- (dolist (elem (split-string text "[ \f\t\n\r\v ]+" t))
- (when (and (bolp)
- (> shr-indentation 0))
- (shr-indent))
- ;; No space is needed behind a wide character categorized as
- ;; kinsoku-bol, between characters both categorized as nospace,
- ;; or at the beginning of a line.
- (let (prev)
- (when (and (> (current-column) shr-indentation)
- (eq (preceding-char) ? )
- (or (= (line-beginning-position) (1- (point)))
- (and (shr-char-breakable-p
- (setq prev (char-after (- (point) 2))))
- (shr-char-kinsoku-bol-p prev))
- (and (shr-char-nospace-p prev)
- (shr-char-nospace-p (aref elem 0)))))
- (delete-char -1)))
- ;; The shr-start is a special variable that is used to pass
- ;; upwards the first point in the buffer where the text really
- ;; starts.
- (unless shr-start
- (setq shr-start (point)))
- (insert elem)
- (setq shr-state nil)
- (let (found)
- (while (and (> (current-column) shr-internal-width)
- (> shr-internal-width 0)
- (progn
- (setq found (shr-find-fill-point))
- (not (eolp))))
- (when (eq (preceding-char) ? )
- (delete-char -1))
- (insert "\n")
- (unless found
- ;; No space is needed at the beginning of a line.
- (when (eq (following-char) ? )
- (delete-char 1)))
- (when (> shr-indentation 0)
- (shr-indent))
- (end-of-line))
- (if (<= (current-column) shr-internal-width)
- (insert " ")
- ;; In case we couldn't get a valid break point (because of a
- ;; word that's longer than `shr-internal-width'), just break anyway.
- (insert "\n")
- (when (> shr-indentation 0)
- (shr-indent)))))
- (unless (string-match "[ \t\r\n ]\\'" text)
- (delete-char -1)))))
-
-(defun shr-find-fill-point ()
- (when (> (move-to-column shr-internal-width) shr-internal-width)
- (backward-char 1))
+ (let ((font-start (point)))
+ (when (and (string-match "\\`[ \t\n\r ]" text)
+ (not (bolp))
+ (not (eq (char-after (1- (point))) ? )))
+ (insert " "))
+ (let ((start (point))
+ (bolp (bolp)))
+ (insert text)
+ (save-restriction
+ (narrow-to-region start (point))
+ (goto-char start)
+ (when (looking-at "[ \t\n\r ]+")
+ (replace-match "" t t))
+ (while (re-search-forward "[ \t\n\r ]+" nil t)
+ (replace-match " " t t))
+ ;; Remove soft hyphens.
+ (goto-char (point-min))
+ (while (search-forward "" nil t)
+ (replace-match "" t t))
+ (goto-char (point-max)))
+ ;; We may have removed everything we inserted if if was just
+ ;; spaces.
+ (unless (= font-start (point))
+ ;; Mark all lines that should possibly be folded afterwards.
+ (when bolp
+ (shr-mark-fill start))
+ (when shr-use-fonts
+ (put-text-property font-start (point)
+ 'face
+ (or shr-current-font 'variable-pitch)))))))))
+
+(defun shr-fill-lines (start end)
+ (if (<= shr-internal-width 0)
+ nil
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+ (when (get-text-property (point) 'shr-indentation)
+ (shr-fill-line))
+ (while (setq start (next-single-property-change start 'shr-indentation))
+ (goto-char start)
+ (when (bolp)
+ (shr-fill-line)))
+ (goto-char (point-max)))))
+
+(defun shr-vertical-motion (column)
+ (if (not shr-use-fonts)
+ (move-to-column column)
+ (unless (eolp)
+ (forward-char 1))
+ (vertical-motion (cons (/ column (frame-char-width)) 0))
+ (unless (eolp)
+ (forward-char 1))))
+
+(defun shr-fill-line ()
+ (let ((shr-indentation (get-text-property (point) 'shr-indentation))
+ (continuation (get-text-property
+ (point) 'shr-continuation-indentation))
+ start)
+ (put-text-property (point) (1+ (point)) 'shr-indentation nil)
+ (let ((face (get-text-property (point) 'face))
+ (background-start (point)))
+ (shr-indent)
+ (when face
+ (put-text-property background-start (point) 'face
+ `,(shr-face-background face))))
+ (setq start (point))
+ (setq shr-indentation (or continuation shr-indentation))
+ (shr-vertical-motion shr-internal-width)
+ (when (looking-at " $")
+ (delete-region (point) (line-end-position)))
+ (while (not (eolp))
+ ;; We have to do some folding. First find the first
+ ;; previous point suitable for folding.
+ (if (or (not (shr-find-fill-point (line-beginning-position)))
+ (= (point) start))
+ ;; We had unbreakable text (for this width), so just go to
+ ;; the first space and carry on.
+ (progn
+ (beginning-of-line)
+ (skip-chars-forward " ")
+ (search-forward " " (line-end-position) 'move)))
+ ;; Success; continue.
+ (when (= (preceding-char) ?\s)
+ (delete-char -1))
+ (let ((face (get-text-property (point) 'face))
+ (background-start (point)))
+ (insert "\n")
+ (shr-indent)
+ (when face
+ (put-text-property background-start (point) 'face
+ `,(shr-face-background face))))
+ (setq start (point))
+ (shr-vertical-motion shr-internal-width)
+ (when (looking-at " $")
+ (delete-region (point) (line-end-position))))))
+
+(defun shr-find-fill-point (start)
(let ((bp (point))
+ (end (point))
failed)
- (while (not (or (setq failed (<= (current-column) shr-indentation))
+ (while (not (or (setq failed (<= (point) start))
(eq (preceding-char) ? )
(eq (following-char) ? )
(shr-char-breakable-p (preceding-char))
(while (and (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
(shr-char-kinsoku-eol-p (preceding-char)))
(backward-char 1))
- (when (setq failed (<= (current-column) shr-indentation))
+ (when (setq failed (<= (point) start))
;; There's no breakable point that doesn't violate kinsoku,
;; so we look for the second best position.
(while (and (progn
(forward-char 1)
- (<= (current-column) shr-internal-width))
+ (<= (point) end))
(progn
(setq bp (point))
(shr-char-kinsoku-eol-p (following-char)))))
(not (memq (preceding-char) (list ?\C-@ ?\n ? )))
(or (shr-char-kinsoku-eol-p (preceding-char))
(shr-char-kinsoku-bol-p (following-char)))))))
- (when (setq failed (<= (current-column) shr-indentation))
+ (when (setq failed (<= (point) start))
;; There's no breakable point that doesn't violate kinsoku,
;; so we go to the second best position.
(if (looking-at "\\(\\c<+\\)\\c<")
(defun shr-ensure-paragraph ()
(unless (bobp)
- (if (<= (current-column) shr-indentation)
- (unless (save-excursion
- (forward-line -1)
- (looking-at " *$"))
- (insert "\n"))
- (if (save-excursion
- (beginning-of-line)
- ;; If the current line is totally blank, and doesn't even
- ;; have any face properties set, then delete the blank
- ;; space.
- (and (looking-at " *$")
- (not (get-text-property (point) 'face))
- (not (= (next-single-property-change (point) 'face nil
- (line-end-position))
- (line-end-position)))))
- (delete-region (match-beginning 0) (match-end 0))
- (insert "\n\n")))))
+ (let ((prefix (get-text-property (line-beginning-position)
+ 'shr-prefix-length)))
+ (cond
+ ((and (bolp)
+ (save-excursion
+ (forward-line -1)
+ (looking-at " *$")))
+ ;; We're already at a new paragraph; do nothing.
+ )
+ ((and prefix
+ (= prefix (- (point) (line-beginning-position))))
+ ;; Do nothing; we're at the start of a <li>.
+ )
+ ((save-excursion
+ (beginning-of-line)
+ ;; If the current line is totally blank, and doesn't even
+ ;; have any face properties set, then delete the blank
+ ;; space.
+ (and (looking-at " *$")
+ (not (get-text-property (point) 'face))
+ (not (= (next-single-property-change (point) 'face nil
+ (line-end-position))
+ (line-end-position)))))
+ (delete-region (match-beginning 0) (match-end 0)))
+ (t
+ (insert "\n\n"))))))
(defun shr-indent ()
(when (> shr-indentation 0)
- (insert (make-string shr-indentation ? ))))
+ (insert
+ (if (not shr-use-fonts)
+ (make-string shr-indentation ?\s)
+ (propertize " "
+ 'display
+ `(space :width (,shr-indentation)))))))
(defun shr-fontize-dom (dom &rest types)
- (let (shr-start)
+ (let ((start (point)))
(shr-generic dom)
(dolist (type types)
- (shr-add-font (or shr-start (point)) (point) type))))
+ (shr-add-font start (point) type))))
;; Add face to the region, but avoid putting the font properties on
;; blank text at the start of the line, and the newline at the end, to
t)))
new-colors)))
-(defun shr-expand-newlines (start end color)
- (save-restriction
- ;; Skip past all white space at the start and ends.
- (goto-char start)
- (skip-chars-forward " \t\n")
- (beginning-of-line)
- (setq start (point))
- (goto-char end)
- (skip-chars-backward " \t\n")
- (forward-line 1)
- (setq end (point))
- (narrow-to-region start end)
- (let ((width (shr-buffer-width))
- column)
- (goto-char (point-min))
- (while (not (eobp))
- (end-of-line)
- (when (and (< (setq column (current-column)) width)
- (< (setq column (shr-previous-newline-padding-width column))
- width))
- (let ((overlay (make-overlay (point) (1+ (point)))))
- (overlay-put overlay 'before-string
- (concat
- (mapconcat
- (lambda (overlay)
- (let ((string (plist-get
- (overlay-properties overlay)
- 'before-string)))
- (if (not string)
- ""
- (overlay-put overlay 'before-string "")
- string)))
- (overlays-at (point))
- "")
- (propertize (make-string (- width column) ? )
- 'face (list :background color))))))
- (forward-line 1)))))
-
(defun shr-previous-newline-padding-width (width)
(let ((overlays (overlays-at (point)))
(previous-width 0))
(defun shr-tag-p (dom)
(shr-ensure-paragraph)
- (shr-indent)
(shr-generic dom)
(shr-ensure-paragraph))
(defun shr-tag-div (dom)
(shr-ensure-newline)
- (shr-indent)
(shr-generic dom)
(shr-ensure-newline))
(defun shr-tag-u (dom)
(shr-fontize-dom dom 'underline))
+(defun shr-tag-tt (dom)
+ (let ((shr-current-font 'default))
+ (shr-generic dom)))
+
(defun shr-parse-style (style)
(when style
(save-match-data
(value (replace-regexp-in-string "^ +\\| +$" "" (cadr elem))))
(when (string-match " *!important\\'" value)
(setq value (substring value 0 (match-beginning 0))))
- (push (cons (intern name obarray)
- value)
- plist)))))
+ (unless (equal value "inherit")
+ (push (cons (intern name obarray)
+ value)
+ plist))))))
plist)))
(defun shr-tag-base (dom)
(when (or url
(and dom
(> (length (dom-attr dom 'src)) 0)))
- (when (and (> (current-column) 0)
- (not (eq shr-state 'image)))
+ (when (> (current-column) 0)
(insert "\n"))
(let ((alt (dom-attr dom 'alt))
(url (shr-expand-url (or url (dom-attr dom 'src)))))
(and shr-blocked-images
(string-match shr-blocked-images url)))
(setq shr-start (point))
- (let ((shr-state 'space))
- (if (> (string-width alt) 8)
- (shr-insert (truncate-string-to-width alt 8))
- (shr-insert alt))))
+ (if (> (string-width alt) 8)
+ (shr-insert (truncate-string-to-width alt 8))
+ (shr-insert alt)))
((and (not shr-ignore-cache)
(url-is-cached (shr-encode-url url)))
(funcall shr-put-image-function (shr-get-image-data url) alt))
(put-text-property start (point) 'image-displayer
(shr-image-displayer shr-content-function))
(put-text-property start (point) 'help-echo
- (shr-fold-text (or (dom-attr dom 'title) alt))))
- (setq shr-state 'image)))))
+ (shr-fill-text
+ (or (dom-attr dom 'title) alt))))))))
(defun shr-tag-pre (dom)
- (let ((shr-folding-mode 'none))
+ (let ((shr-folding-mode 'none)
+ (shr-current-font 'default))
(shr-ensure-newline)
- (shr-indent)
(shr-generic dom)
(shr-ensure-newline)))
(defun shr-tag-blockquote (dom)
(shr-ensure-paragraph)
- (shr-indent)
- (let ((shr-indentation (+ shr-indentation 4)))
- (shr-generic dom))
- (shr-ensure-paragraph))
+ (let ((start (point))
+ (shr-indentation (+ shr-indentation
+ (* 4 shr-table-separator-pixel-width))))
+ (shr-generic dom)
+ (shr-ensure-paragraph)
+ (shr-mark-fill start)))
(defun shr-tag-dl (dom)
(shr-ensure-paragraph)
(defun shr-tag-dd (dom)
(shr-ensure-newline)
- (let ((shr-indentation (+ shr-indentation 4)))
+ (let ((shr-indentation (+ shr-indentation
+ (* 4 shr-table-separator-pixel-width))))
(shr-generic dom)))
(defun shr-tag-ul (dom)
(defun shr-tag-li (dom)
(shr-ensure-newline)
- (shr-indent)
- (let* ((bullet
- (if (numberp shr-list-mode)
- (prog1
- (format "%d " shr-list-mode)
- (setq shr-list-mode (1+ shr-list-mode)))
- shr-bullet))
- (shr-indentation (+ shr-indentation (length bullet))))
- (insert bullet)
- (shr-generic dom)))
+ (let ((start (point)))
+ (let* ((bullet
+ (if (numberp shr-list-mode)
+ (prog1
+ (format "%d " shr-list-mode)
+ (setq shr-list-mode (1+ shr-list-mode)))
+ (car shr-internal-bullet)))
+ (width (if (numberp shr-list-mode)
+ (shr-string-pixel-width bullet)
+ (cdr shr-internal-bullet))))
+ (insert bullet)
+ (shr-mark-fill start)
+ (let ((shr-indentation (+ shr-indentation width)))
+ (put-text-property start (1+ start)
+ 'shr-continuation-indentation shr-indentation)
+ (put-text-property start (1+ start) 'shr-prefix-length (length bullet))
+ (shr-generic dom)))))
+
+(defun shr-mark-fill (start)
+ ;; We may not have inserted any text to fill.
+ (unless (= start (point))
+ (put-text-property start (1+ start)
+ 'shr-indentation shr-indentation)))
(defun shr-tag-br (dom)
(when (and (not (bobp))
(or (not (bolp))
(and (> (- (point) 2) (point-min))
(not (= (char-after (- (point) 2)) ?\n)))))
- (insert "\n")
- (shr-indent))
+ (insert "\n"))
(shr-generic dom))
(defun shr-tag-span (dom)
(shr-generic dom))
(defun shr-tag-h1 (dom)
- (shr-heading dom 'bold 'underline))
+ (shr-heading dom (if shr-use-fonts
+ '(variable-pitch (:height 1.3 :weight bold))
+ 'bold)))
(defun shr-tag-h2 (dom)
(shr-heading dom 'bold))
(defun shr-tag-hr (_dom)
(shr-ensure-newline)
- (insert (make-string shr-internal-width shr-hr-line) "\n"))
+ (insert (make-string (if (not shr-use-fonts)
+ shr-internal-width
+ (1+ (/ shr-internal-width
+ shr-table-separator-pixel-width)))
+ shr-hr-line)
+ "\n"))
(defun shr-tag-title (dom)
(shr-heading dom 'bold 'underline))
(shr-kinsoku-shorten t)
;; Find all suggested widths.
(columns (shr-column-specs dom))
- ;; Compute how many characters wide each TD should be.
+ ;; Compute how many pixels wide each TD should be.
(suggested-widths (shr-pro-rate-columns columns))
;; Do a "test rendering" to see how big each TD is (this can
;; be smaller (if there's little text) or bigger (if there's
;; unbreakable text).
- (sketch (shr-make-table dom suggested-widths))
- ;; Compute the "natural" width by setting each column to 500
- ;; characters and see how wide they really render.
- (natural (shr-make-table dom (make-vector (length columns) 500)))
+ (elems (or (dom-attr dom 'shr-suggested-widths)
+ (shr-make-table dom suggested-widths nil
+ 'shr-suggested-widths)))
+ (sketch (loop for line in elems
+ collect (mapcar #'car line)))
+ (natural (loop for line in elems
+ collect (mapcar #'cdr line)))
(sketch-widths (shr-table-widths sketch natural suggested-widths)))
;; This probably won't work very well.
(when (> (+ (loop for width across sketch-widths
summing (1+ width))
- shr-indentation 1)
+ shr-indentation shr-table-separator-pixel-width)
(frame-width))
(setq truncate-lines t))
;; Then render the table again with these new "hard" widths.
;; Try to output it anyway.
(shr-generic dom)
;; It's a real table, so render it.
- (shr-tag-table-1
- (nconc
- (list 'table nil)
- (if caption `((tr nil (td nil ,@caption))))
- (cond (header
- (if footer
- ;; header + body + footer
- (if (= nheader nbody)
- (if (= nbody nfooter)
- `((tr nil (td nil (table nil
- (tbody nil ,@header
- ,@body ,@footer)))))
- (nconc `((tr nil (td nil (table nil
- (tbody nil ,@header
- ,@body)))))
- (if (= nfooter 1)
- footer
- `((tr nil (td nil (table
- nil (tbody
- nil ,@footer))))))))
- (nconc `((tr nil (td nil (table nil (tbody
- nil ,@header)))))
- (if (= nbody nfooter)
- `((tr nil (td nil (table
- nil (tbody nil ,@body
- ,@footer)))))
- (nconc `((tr nil (td nil (table
- nil (tbody nil
+ (if (dom-attr dom 'shr-fixed-table)
+ (shr-tag-table-1 dom)
+ ;; Only fix up the table once.
+ (let ((table
+ (nconc
+ (list 'table nil)
+ (if caption `((tr nil (td nil ,@caption))))
+ (cond
+ (header
+ (if footer
+ ;; header + body + footer
+ (if (= nheader nbody)
+ (if (= nbody nfooter)
+ `((tr nil (td nil (table nil
+ (tbody nil ,@header
+ ,@body ,@footer)))))
+ (nconc `((tr nil (td nil (table nil
+ (tbody nil ,@header
,@body)))))
- (if (= nfooter 1)
- footer
- `((tr nil (td nil (table
- nil
- (tbody
- nil
- ,@footer))))))))))
- ;; header + body
- (if (= nheader nbody)
- `((tr nil (td nil (table nil (tbody nil ,@header
- ,@body)))))
- (if (= nheader 1)
- `(,@header (tr nil (td nil (table
- nil (tbody nil ,@body)))))
- `((tr nil (td nil (table nil (tbody nil ,@header))))
- (tr nil (td nil (table nil (tbody nil ,@body)))))))))
- (footer
- ;; body + footer
- (if (= nbody nfooter)
- `((tr nil (td nil (table
- nil (tbody nil ,@body ,@footer)))))
- (nconc `((tr nil (td nil (table nil (tbody nil ,@body)))))
- (if (= nfooter 1)
- footer
- `((tr nil (td nil (table
- nil (tbody nil ,@footer)))))))))
- (caption
- `((tr nil (td nil (table nil (tbody nil ,@body))))))
- (body)))))
+ (if (= nfooter 1)
+ footer
+ `((tr nil (td nil (table
+ nil (tbody
+ nil ,@footer))))))))
+ (nconc `((tr nil (td nil (table nil (tbody
+ nil ,@header)))))
+ (if (= nbody nfooter)
+ `((tr nil (td nil (table
+ nil (tbody nil ,@body
+ ,@footer)))))
+ (nconc `((tr nil (td nil (table
+ nil (tbody nil
+ ,@body)))))
+ (if (= nfooter 1)
+ footer
+ `((tr nil (td nil (table
+ nil
+ (tbody
+ nil
+ ,@footer))))))))))
+ ;; header + body
+ (if (= nheader nbody)
+ `((tr nil (td nil (table nil (tbody nil ,@header
+ ,@body)))))
+ (if (= nheader 1)
+ `(,@header (tr nil (td nil (table
+ nil (tbody nil ,@body)))))
+ `((tr nil (td nil (table nil (tbody nil ,@header))))
+ (tr nil (td nil (table nil (tbody nil ,@body)))))))))
+ (footer
+ ;; body + footer
+ (if (= nbody nfooter)
+ `((tr nil (td nil (table
+ nil (tbody nil ,@body ,@footer)))))
+ (nconc `((tr nil (td nil (table nil (tbody nil ,@body)))))
+ (if (= nfooter 1)
+ footer
+ `((tr nil (td nil (table
+ nil (tbody nil ,@footer)))))))))
+ (caption
+ `((tr nil (td nil (table nil (tbody nil ,@body))))))
+ (body)))))
+ (dom-set-attribute table 'shr-fixed-table t)
+ (setcdr dom (cdr table))
+ (shr-tag-table-1 dom))))
(when bgcolor
(shr-colorize-region start (point) (cdr (assq 'color shr-stylesheet))
bgcolor))
;; model isn't strong enough to allow us to put the images actually
;; into the tables.
(when (zerop shr-table-depth)
+ (save-excursion
+ (shr-expand-alignments start (point)))
(dolist (elem (dom-by-tag dom 'object))
(shr-tag-object elem))
(dolist (elem (dom-by-tag dom 'img))
(let* ((collapse (equal (cdr (assq 'border-collapse shr-stylesheet))
"collapse"))
(shr-table-separator-length (if collapse 0 1))
- (shr-table-vertical-line (if collapse "" shr-table-vertical-line)))
+ (shr-table-vertical-line (if collapse "" shr-table-vertical-line))
+ (start (point)))
+ (setq shr-table-id (1+ shr-table-id))
(unless collapse
(shr-insert-table-ruler widths))
(dolist (row table)
(let ((start (point))
+ (align 0)
+ (column-number 0)
(height (let ((max 0))
(dolist (column row)
- (setq max (max max (cadr column))))
+ (setq max (max max (nth 2 column))))
max)))
- (dotimes (i height)
+ (dotimes (i (max height 1))
(shr-indent)
(insert shr-table-vertical-line "\n"))
(dolist (column row)
- (goto-char start)
- (let ((lines (nth 2 column)))
- (dolist (line lines)
- (end-of-line)
- (insert line shr-table-vertical-line)
- (forward-line 1))
- ;; Add blank lines at padding at the bottom of the TD,
- ;; possibly.
- (dotimes (i (- height (length lines)))
- (end-of-line)
- (let ((start (point)))
- (insert (make-string (string-width (car lines)) ? )
- shr-table-vertical-line)
- (when (nth 4 column)
- (shr-add-font start (1- (point))
- (list :background (nth 4 column)))))
- (forward-line 1)))))
+ (when (> (nth 2 column) -1)
+ (goto-char start)
+ ;; Sum up all the widths from the column. (There may be
+ ;; more than one if this is a "colspan" column.)
+ (dotimes (i (nth 4 column))
+ ;; The colspan directive may be wrong and there may not be
+ ;; that number of columns.
+ (when (<= column-number (1- (length widths)))
+ (setq align (+ align
+ (aref widths column-number)
+ (* 2 shr-table-separator-pixel-width))))
+ (setq column-number (1+ column-number)))
+ (let ((lines (nth 3 column))
+ (pixel-align (if (not shr-use-fonts)
+ (* align (frame-char-width))
+ align)))
+ (dolist (line lines)
+ (end-of-line)
+ (let ((start (point)))
+ (insert
+ line
+ (propertize " "
+ 'display `(space :align-to (,pixel-align))
+ 'face (and (> (length line) 0)
+ (shr-face-background
+ (get-text-property
+ (1- (length line)) 'face line)))
+ 'shr-table-indent shr-table-id)
+ shr-table-vertical-line)
+ (shr-colorize-region
+ start (1- (point)) (nth 5 column) (nth 6 column)))
+ (forward-line 1))
+ ;; Add blank lines at padding at the bottom of the TD,
+ ;; possibly.
+ (dotimes (i (- height (length lines)))
+ (end-of-line)
+ (let ((start (point)))
+ (insert (propertize " "
+ 'display `(space :align-to (,pixel-align))
+ 'shr-table-indent shr-table-id)
+ shr-table-vertical-line)
+ (shr-colorize-region
+ start (1- (point)) (nth 5 column) (nth 6 column)))
+ (forward-line 1))))))
(unless collapse
- (shr-insert-table-ruler widths)))))
+ (shr-insert-table-ruler widths)))
+ (unless (= start (point))
+ (put-text-property start (1+ start) 'shr-table-id shr-table-id))))
+
+(defun shr-face-background (face)
+ (and (consp face)
+ (let ((background nil))
+ (dolist (elem face)
+ (when (and (consp elem)
+ (eq (car elem) :background))
+ (setq background (cadr elem))))
+ (and background
+ (list :background background)))))
+
+(defun shr-expand-alignments (start end)
+ (while (< (setq start (next-single-property-change
+ start 'shr-table-id nil end))
+ end)
+ (goto-char start)
+ (let* ((shr-use-fonts t)
+ (id (get-text-property (point) 'shr-table-id))
+ (base (shr-pixel-column))
+ elem)
+ (when id
+ (save-excursion
+ (while (setq elem (text-property-any
+ (point) end 'shr-table-indent id))
+ (goto-char elem)
+ (let ((align (get-text-property (point) 'display)))
+ (put-text-property (point) (1+ (point)) 'display
+ `(space :align-to (,(+ (car (nth 2 align))
+ base)))))
+ (forward-char 1)))))
+ (setq start (1+ start))))
(defun shr-insert-table-ruler (widths)
(when shr-table-horizontal-line
(> shr-indentation 0))
(shr-indent))
(insert shr-table-corner)
- (dotimes (i (length widths))
- (insert (make-string (aref widths i) shr-table-horizontal-line)
- shr-table-corner))
+ (let ((total-width 0))
+ (dotimes (i (length widths))
+ (setq total-width (+ total-width (aref widths i)
+ (* shr-table-separator-pixel-width 2)))
+ (insert (make-string (1+ (/ (aref widths i)
+ shr-table-separator-pixel-width))
+ shr-table-horizontal-line)
+ (propertize " "
+ 'display `(space :align-to (,total-width))
+ 'shr-table-indent shr-table-id)
+ shr-table-corner)))
(insert "\n")))
(defun shr-table-widths (table natural-table suggested-widths)
(aset natural-widths i (max (aref natural-widths i) column))
(setq i (1+ i)))))
(let ((extra (- (apply '+ (append suggested-widths nil))
- (apply '+ (append widths nil))))
+ (apply '+ (append widths nil))
+ (* shr-table-separator-pixel-width (1+ (length widths)))))
(expanded-columns 0))
;; We have extra, unused space, so divide this space amongst the
;; columns.
(aref widths i))))))))
widths))
-(defun shr-make-table (dom widths &optional fill)
+(defun shr-make-table (dom widths &optional fill storage-attribute)
(or (cadr (assoc (list dom widths fill) shr-content-cache))
(let ((data (shr-make-table-1 dom widths fill)))
(push (list (list dom widths fill) data)
shr-content-cache)
+ (when storage-attribute
+ (dom-set-attribute dom storage-attribute data))
data)))
(defun shr-make-table-1 (dom widths &optional fill)
(dolist (row (dom-non-text-children dom))
(when (eq (dom-tag row) 'tr)
(let ((tds nil)
- (columns (dom-children row))
+ (columns (dom-non-text-children row))
(i 0)
(width-column 0)
column)
(setq width
(if column
(aref widths width-column)
- 10))
+ (* 10 shr-table-separator-pixel-width)))
(when (setq colspan (dom-attr column 'colspan))
(setq colspan (min (string-to-number colspan)
;; The colspan may be wrong, so
(setq width-column (+ width-column (1- colspan))
colspan-count colspan
colspan-remaining colspan))
- (when (or column
- (not fill))
+ (when column
(let ((data (shr-render-td column width fill)))
(if (and (not fill)
(> colspan-remaining 0))
(progn
- (when (= colspan-count colspan-remaining)
- (setq colspan-width data))
+ (setq colspan-width (car data))
(let ((this-width (/ colspan-width colspan-count)))
- (push this-width tds)
+ (push (cons this-width (cadr data)) tds)
(setq colspan-remaining (1- colspan-remaining))))
- (push data tds))))
+ (if (not fill)
+ (push (cons (car data) (cadr data)) tds)
+ (push data tds)))))
+ (when (and colspan
+ (> colspan 1))
+ (dotimes (c (1- colspan))
+ (setq i (1+ i))
+ (push
+ (if fill
+ (list 0 0 -1 nil 1 nil nil)
+ '(0 . 0))
+ tds)))
(setq i (1+ i)
width-column (1+ width-column))))
(push (nreverse tds) trs))))
(nreverse trs)))
+(defun shr-pixel-buffer-width ()
+ (if (not shr-use-fonts)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((max 0))
+ (while (not (eobp))
+ (end-of-line)
+ (setq max (max max (current-column)))
+ (forward-line 1))
+ max))
+ (if (get-buffer-window)
+ (car (window-text-pixel-size nil (point-min) (point-max)))
+ (save-window-excursion
+ (set-window-buffer nil (current-buffer))
+ (car (window-text-pixel-size nil (point-min) (point-max)))))))
+
(defun shr-render-td (dom width fill)
+ (let ((cache (intern (format "shr-td-cache-%s-%s" width fill))))
+ (or (dom-attr dom cache)
+ (and fill
+ (let (result)
+ (dolist (attr (dom-attributes dom))
+ (let ((name (symbol-name (car attr))))
+ (when (string-match "shr-td-cache-\\([0-9]+\\)-nil" name)
+ (let ((cache-width (string-to-number
+ (match-string 1 name))))
+ (when (and (>= cache-width width)
+ (<= (car (cdr attr)) width))
+ (setq result (cdr attr)))))))
+ result))
+ (let ((result (shr-render-td-1 dom width fill)))
+ (dom-set-attribute dom cache result)
+ result))))
+
+(defun shr-render-td-1 (dom width fill)
(with-temp-buffer
(let ((bgcolor (dom-attr dom 'bgcolor))
(fgcolor (dom-attr dom 'fgcolor))
(style (dom-attr dom 'style))
(shr-stylesheet shr-stylesheet)
- actual-colors)
+ (max-width 0)
+ natural-width)
(when style
(setq style (and (string-match "color" style)
(shr-parse-style style))))
(when bgcolor
- (setq style (nconc (list (cons 'background-color bgcolor)) style)))
+ (setq style (nconc (list (cons 'background-color bgcolor))
+ style)))
(when fgcolor
(setq style (nconc (list (cons 'color fgcolor)) style)))
(when style
(let ((shr-internal-width width)
(shr-indentation 0))
(shr-descend dom))
+ (save-window-excursion
+ (set-window-buffer nil (current-buffer))
+ (unless fill
+ (setq natural-width
+ (or (dom-attr dom 'shr-td-cache-natural)
+ (let ((natural (max (shr-pixel-buffer-width)
+ (shr-dom-max-natural-width dom 0))))
+ (dom-set-attribute dom 'shr-td-cache-natural natural)
+ natural))))
+ (if (and natural-width
+ (<= natural-width width))
+ (setq max-width natural-width)
+ (let ((shr-internal-width width))
+ (shr-fill-lines (point-min) (point-max))
+ (setq max-width (shr-pixel-buffer-width)))))
+ (goto-char (point-max))
;; Delete padding at the bottom of the TDs.
(delete-region
(point)
(end-of-line)
(point)))
(goto-char (point-min))
- (let ((max 0))
- (while (not (eobp))
- (end-of-line)
- (setq max (max max (current-column)))
- (forward-line 1))
- (when fill
- (goto-char (point-min))
- ;; If the buffer is totally empty, then put a single blank
- ;; line here.
- (if (zerop (buffer-size))
- (insert (make-string width ? ))
- ;; Otherwise, fill the buffer.
- (let ((align (dom-attr dom 'align))
- length)
- (while (not (eobp))
- (end-of-line)
- (setq length (- width (current-column)))
- (when (> length 0)
- (cond
- ((equal align "right")
- (beginning-of-line)
- (insert (make-string length ? )))
- ((equal align "center")
- (insert (make-string (/ length 2) ? ))
- (beginning-of-line)
- (insert (make-string (- length (/ length 2)) ? )))
- (t
- (insert (make-string length ? )))))
- (forward-line 1))))
- (when style
- (setq actual-colors
- (shr-colorize-region
- (point-min) (point-max)
- (cdr (assq 'color shr-stylesheet))
- (cdr (assq 'background-color shr-stylesheet))))))
- (if fill
- (list max
- (count-lines (point-min) (point-max))
- (split-string (buffer-string) "\n")
- nil
- (car actual-colors))
- max)))))
+ (list max-width
+ natural-width
+ (count-lines (point-min) (point-max))
+ (split-string (buffer-string) "\n")
+ (if (dom-attr dom 'colspan)
+ (string-to-number (dom-attr dom 'colspan))
+ 1)
+ (cdr (assq 'color shr-stylesheet))
+ (cdr (assq 'background-color shr-stylesheet))))))
+
+(defun shr-dom-max-natural-width (dom max)
+ (if (eq (dom-tag dom) 'table)
+ (max max (or
+ (loop for line in (dom-attr dom 'shr-suggested-widths)
+ maximize (+
+ shr-table-separator-length
+ (loop for elem in line
+ summing
+ (+ (cdr elem)
+ (* 2 shr-table-separator-length)))))
+ 0))
+ (dolist (child (dom-children dom))
+ (unless (stringp child)
+ (setq max (max (shr-dom-max-natural-width child max)))))
+ max))
(defun shr-buffer-width ()
(goto-char (point-min))
(aset widths i (max (truncate (* (aref columns i)
total-percentage
(- shr-internal-width
- (1+ (length columns)))))
+ (* (1+ (length columns))
+ shr-table-separator-pixel-width))))
10)))
widths))
(dolist (row (dom-non-text-children dom))
(when (eq (dom-tag row) 'tr)
(let ((i 0))
- (dolist (column (dom-children row))
- (when (and (not (stringp column))
- (memq (dom-tag column) '(td th)))
+ (dolist (column (dom-non-text-children row))
+ (when (memq (dom-tag column) '(td th))
(let ((width (dom-attr column 'width)))
(when (and width
(string-match "\\([0-9]+\\)%" width)
;; Pacify byte-compiler.
(defvar directory-sep-char)
+;;;###tramp-autoload
(defcustom tramp-adb-program "adb"
"Name of the Android Debug Bridge program."
:group 'tramp
:version "24.4"
:type 'string)
+;;;###tramp-autoload
+(defcustom tramp-adb-connect-if-not-connected nil
+ "Try to run `adb connect' if provided device is not connected currently.
+It is used for TCP/IP devices."
+ :group 'tramp
+ :version "25.1"
+ :type 'boolean)
+
;;;###tramp-autoload
(defconst tramp-adb-method "adb"
"*When this method name is used, forward all calls to Android Debug Bridge.")
+;;;###tramp-autoload
(defcustom tramp-adb-prompt
"^\\(?:[[:digit:]]*|?\\)?\\(?:[[:alnum:]]*@[[:alnum:]]*[^#\\$]*\\)?[#\\$][[:space:]]"
"Regexp used as prompt in almquist shell."
"[[:space:]]+\\([^[:space:]]+\\)" ; \3 group
"[[:space:]]+\\([[:digit:]]+\\)" ; \4 size
"[[:space:]]+\\([-[:digit:]]+[[:space:]][:[:digit:]]+\\)" ; \5 date
- "[[:space:]]+\\(.*\\)$")) ; \6 filename
+ "[[:space:]]\\(.*\\)$")) ; \6 filename
;;;###tramp-autoload
(add-to-list 'tramp-methods
`(,tramp-adb-method
- (tramp-tmpdir "/data/local/tmp")))
+ (tramp-tmpdir "/data/local/tmp")
+ (tramp-default-port 5555)))
;;;###tramp-autoload
(add-to-list 'tramp-default-host-alist `(,tramp-adb-method nil ""))
;; That's why we use `start-process'.
(let ((p (start-process
tramp-adb-program (current-buffer) tramp-adb-program "devices"))
+ (v (vector tramp-adb-method tramp-current-user
+ tramp-current-host nil nil))
result)
+ (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " "))
(tramp-compat-set-process-query-on-exit-flag p nil)
(while (eq 'run (process-status p))
(accept-process-output p 0.1))
(accept-process-output p 0.1)
+ (tramp-message v 6 "\n%s" (buffer-string))
(goto-char (point-min))
(while (search-forward-regexp "^\\(\\S-+\\)[[:space:]]+device$" nil t)
(add-to-list 'result (list nil (match-string 1))))
+
+ ;; Replace ":" by "#".
+ (mapc
+ (lambda (elt)
+ (setcar
+ (cdr elt)
+ (replace-regexp-in-string
+ ":" tramp-prefix-port-format (car (cdr elt)))))
+ result)
result))))
(defun tramp-adb-handle-expand-file-name (name &optional dir)
(tramp-adb-send-command
v (format "%s -d -a -l %s %s"
(tramp-adb-get-ls-command v)
- (concat (file-name-as-directory localname) ".")
- (concat (file-name-as-directory localname) "..")))
+ (tramp-shell-quote-argument
+ (concat (file-name-as-directory localname) "."))
+ (tramp-shell-quote-argument
+ (concat (file-name-as-directory localname) ".."))))
(widen))
(tramp-adb-sh-fix-ls-output)
(let ((result (tramp-do-parse-file-attributes-with-ls
(tramp-set-connection-property v "process-name" nil)
(tramp-set-connection-property v "process-buffer" nil))))))
-;; Helper functions.
+(defun tramp-adb-get-device (vec)
+ "Return full host name from VEC to be used in shell execution.
+E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
+ a host name \"R38273882DE\" returns \"R38273882DE\"."
+ ;; Sometimes this is called before there is a connection process
+ ;; yet. In order to work with the connection cache, we flush all
+ ;; unwanted entries first.
+ (tramp-flush-connection-property nil)
+ (with-tramp-connection-property (tramp-get-connection-process vec) "device"
+ (let* ((method (tramp-file-name-method vec))
+ (host (tramp-file-name-host vec))
+ (port (tramp-file-name-port vec))
+ (devices (mapcar 'cadr (tramp-adb-parse-device-names nil))))
+ (replace-regexp-in-string
+ tramp-prefix-port-format ":"
+ (cond ((member host devices) host)
+ ;; This is the case when the host is connected to the default port.
+ ((member (format "%s%s%d" host tramp-prefix-port-format port)
+ devices)
+ (format "%s:%d" host port))
+ ;; An empty host name shall be mapped as well, when there
+ ;; is exactly one entry in `devices'.
+ ((and (zerop (length host)) (= (length devices) 1))
+ (car devices))
+ ;; Try to connect device.
+ ((and tramp-adb-connect-if-not-connected
+ (not (zerop (length host)))
+ (not (tramp-adb-execute-adb-command
+ vec "connect"
+ (replace-regexp-in-string
+ tramp-prefix-port-format ":" host))))
+ ;; When new device connected, running other adb command (e.g.
+ ;; adb shell) immediately will fail. To get around this
+ ;; problem, add sleep 0.1 second here.
+ (sleep-for 0.1)
+ host)
+ (t (tramp-error
+ vec 'file-error "Could not find device %s" host)))))))
(defun tramp-adb-execute-adb-command (vec &rest args)
"Returns nil on success error-output on failure."
- (when (> (length (tramp-file-name-host vec)) 0)
- (setq args (append (list "-s" (tramp-file-name-host vec)) args)))
+ (when (and (> (length (tramp-file-name-host vec)) 0)
+ ;; The -s switch is only available for ADB device commands.
+ (not (member (car args) (list "connect" "disconnect"))))
+ (setq args (append (list "-s" (tramp-adb-get-device vec)) args)))
(with-temp-buffer
(prog1
(unless
(p (get-buffer-process buf))
(host (tramp-file-name-host vec))
(user (tramp-file-name-user vec))
- devices)
+ (device (tramp-adb-get-device vec)))
+
+ ;; Set variables for proper tracing in `tramp-adb-parse-device-names'.
+ (setq tramp-current-method (tramp-file-name-method vec)
+ tramp-current-user (tramp-file-name-user vec)
+ tramp-current-host (tramp-file-name-host vec))
;; Maybe we know already that "su" is not supported. We cannot
;; use a connection property, because we have not checked yet
(and p (processp p) (memq (process-status p) '(run open)))
(save-match-data
(when (and p (processp p)) (delete-process p))
- (setq devices (mapcar 'cadr (tramp-adb-parse-device-names nil)))
- (if (not devices)
- (tramp-error vec 'file-error "No device connected"))
- (if (and (> (length host) 0) (not (member host devices)))
+ (if (zerop (length device))
(tramp-error vec 'file-error "Device %s not connected" host))
- (if (and (> (length devices) 1) (zerop (length host)))
- (tramp-error
- vec 'file-error
- "Multiple Devices connected: No Host/Device specified"))
(with-tramp-progress-reporter vec 3 "Opening adb shell connection"
(let* ((coding-system-for-read 'utf-8-dos) ;is this correct?
(process-connection-type tramp-process-connection-type)
(args (if (> (length host) 0)
- (list "-s" host "shell")
+ (list "-s" device "shell")
(list "shell")))
(p (let ((default-directory
(tramp-compat-temporary-file-directory)))
(unload-feature 'tramp-adb 'force)))
(provide 'tramp-adb)
+
;;; tramp-adb.el ends here
;;;###tramp-autoload
(defun tramp-flush-file-property (key file)
"Remove all properties of FILE in the cache context of KEY."
- ;; Remove file properties of symlinks.
- (let ((truename (tramp-get-file-property key file "file-truename" nil)))
+ (let* ((file (tramp-run-real-handler
+ 'directory-file-name (list file)))
+ (truename (tramp-get-file-property key file "file-truename" nil)))
+ ;; Remove file properties of symlinks.
(when (and (stringp truename)
- (not (string-equal file truename)))
+ (not (string-equal file (directory-file-name truename))))
(tramp-flush-file-property key truename)))
;; Unify localname.
(setq key (copy-sequence key))
- (aset key 3 (tramp-run-real-handler 'directory-file-name (list file)))
+ (aset key 3 file)
(tramp-message key 8 "%s" file)
(remhash key tramp-cache-data))
(truename (tramp-get-file-property key directory "file-truename" nil)))
;; Remove file properties of symlinks.
(when (and (stringp truename)
- (not (string-equal directory truename)))
+ (not (string-equal directory (directory-file-name truename))))
(tramp-flush-directory-property key truename))
(tramp-message key 8 "%s" directory)
(maphash
(lambda (key _value)
(when (and (stringp (tramp-file-name-localname key))
- (string-match directory (tramp-file-name-localname key)))
+ (string-match (regexp-quote directory)
+ (tramp-file-name-localname key)))
(remhash key tramp-cache-data)))
tramp-cache-data)))
(remhash key cache)))
cache)
;; Dump it.
- (with-temp-buffer
+ (with-temp-file tramp-persistency-file-name
(insert
";; -*- emacs-lisp -*-"
;; `time-stamp-string' might not exist in all (X)Emacs flavors.
";; Tramp connection history. Don't change this file.\n"
";; You can delete it, forcing Tramp to reapply the checks.\n\n"
(with-output-to-string
- (pp (read (format "(%s)" (tramp-cache-print cache))))))
- (write-region
- (point-min) (point-max) tramp-persistency-file-name))))))
+ (pp (read (format "(%s)" (tramp-cache-print cache)))))))))))
(unless noninteractive
(add-hook 'kill-emacs-hook 'tramp-dump-connection-properties))
;;;###tramp-autoload
(add-to-list 'tramp-default-user-alist '("\\`synce\\'" nil nil))
+;;;###tramp-autoload
(defcustom tramp-gvfs-zeroconf-domain "local"
"Zeroconf domain to be used for discovering services, like host names."
:group 'tramp
;; </signal>
;; </interface>
+;;;###tramp-autoload
(defcustom tramp-bluez-discover-devices-timeout 60
"Defines seconds since last bluetooth device discovery before rescanning.
A value of 0 would require an immediate discovery during hostname
(defvar vc-git-program)
(defvar vc-hg-program)
+;;;###tramp-autoload
(defcustom tramp-inline-compress-start-size 4096
"The minimum size of compressing where inline transfer.
When inline transfer, compress transferred data of file
:group 'tramp
:type '(choice (const nil) integer))
+;;;###tramp-autoload
(defcustom tramp-copy-size-limit 10240
"The maximum file size where inline copying is preferred over an \
out-of-the-band copy.
:type 'string)
;;;###tramp-autoload
-(defcustom tramp-histfile-override "/dev/null"
+(defcustom tramp-histfile-override t
"When invoking a shell, override the HISTFILE with this value.
-By default, the HISTFILE is set to the \"/dev/null\" value, which
-is special on Unix systems and indicates the shell history should
-not be logged (this avoids clutter due to Tramp commands).
-
-If you set this variable to nil, however, the *override* is
-disabled, so the history will go to the default storage
-location, e.g. \"$HOME/.sh_history\"."
+When setting to a string, it redirects the shell history to that
+file. Be careful when setting to \"/dev/null\"; this might
+result in undesired results when using \"bash\" as shell.
+
+The value t, the default value, unsets any setting of HISTFILE,
+and sets both HISTFILESIZE and HISTSIZE to 0. If you set this
+variable to nil, however, the *override* is disabled, so the
+history will go to the default storage location,
+e.g. \"$HOME/.sh_history\"."
:group 'tramp
:version "25.1"
:type '(choice (const :tag "Do not override HISTFILE" nil)
- (const :tag "Empty the history (/dev/null)" "/dev/null")
+ (const :tag "Unset HISTFILE" t)
(string :tag "Redirect to a file")))
;;;###tramp-autoload
(defconst tramp-end-of-heredoc (md5 tramp-end-of-output)
"String used to recognize end of heredoc strings.")
+;;;###tramp-autoload
+(defcustom tramp-use-ssh-controlmaster-options t
+ "Whether to use `tramp-ssh-controlmaster-options'."
+ :group 'tramp
+ :version "24.4"
+ :type 'boolean)
+
+(defvar tramp-ssh-controlmaster-options nil
+ "Which ssh Control* arguments to use.
+
+If it is a string, it should have the form
+\"-o ControlMaster=auto -o ControlPath='tramp.%%r@%%h:%%p'
+-o ControlPersist=no\". Percent characters in the ControlPath
+spec must be doubled, because the string is used as format string.
+
+Otherwise, it will be auto-detected by Tramp, if
+`tramp-use-ssh-controlmaster-options' is non-nil. The value
+depends on the installed local ssh version.
+
+The string is used in `tramp-methods'.")
+
;; Initialize `tramp-methods' with the supported methods.
;;;###tramp-autoload
(add-to-list 'tramp-methods
,(format "TERM=%s" tramp-terminal-type)
"EMACS=t" ;; Deprecated.
,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version)
- "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=\"\""
+ "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=cat"
"autocorrect=" "correct=")
"List of environment variables to be set on the remote host.
:version "24.4"
:type '(repeat string))
+;;;###tramp-autoload
(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile"))
"Alist specifying extra arguments to pass to the remote shell.
Entries are (REGEXP . ARGS) where REGEXP is a regular expression
if (($stat[2] & 0170000) == 0120000)
{
$type = readlink($ARGV[0]);
+ $type =~ s/\"/\\\\\"/g;
$type = \"\\\"$type\\\"\";
}
elsif (($stat[2] & 0170000) == 040000)
if (($stat[2] & 0170000) == 0120000)
{
$type = readlink($filename);
+ $type =~ s/\"/\\\\\"/g;
$type = \"\\\"$type\\\"\";
}
elsif (($stat[2] & 0170000) == 040000)
};
$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
+ $filename =~ s/\"/\\\\\"/g;
printf(
\"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) (%%u . %%u))\\n\",
$filename,
(tramp-message vec 5 "file attributes with ls: %s" localname)
(tramp-send-command
vec
- (format "(%s %s || %s -h %s) && %s %s %s"
+ (format "(%s %s || %s -h %s) && %s %s %s %s"
(tramp-get-file-exists-command vec)
(tramp-shell-quote-argument localname)
(tramp-get-test-command vec)
(tramp-shell-quote-argument localname)
(tramp-get-ls-command vec)
+ ;; On systems which have no quoting style, file names
+ ;; with special characters could fail.
+ (if (tramp-get-ls-command-with-quoting-style vec)
+ "--quoting-style=c" "")
(if (eq id-format 'integer) "-ildn" "-ild")
(tramp-shell-quote-argument localname)))
- ;; parse `ls -l' output ...
+ ;; Parse `ls -l' output ...
(with-current-buffer (tramp-get-buffer vec)
(when (> (buffer-size) 0)
(goto-char (point-min))
;; From the file modes, figure out other stuff.
(setq symlinkp (eq ?l (aref res-filemodes 0)))
(setq dirp (eq ?d (aref res-filemodes 0)))
- ;; if symlink, find out file name pointed to
+ ;; If symlink, find out file name pointed to.
(when symlinkp
(search-forward "-> ")
- (setq res-symlink-target (buffer-substring (point) (point-at-eol))))
- ;; return data gathered
+ (setq res-symlink-target
+ (if (tramp-get-ls-command-with-quoting-style vec)
+ (read (current-buffer))
+ (buffer-substring (point) (point-at-eol)))))
+ ;; Return data gathered.
(list
;; 0. t for directory, string (name linked to) for symbolic
;; link, or nil.
;; 8. File modes, as a string of ten letters or dashes as in ls -l.
res-filemodes
;; 9. t if file's gid would change if file were deleted and
- ;; recreated. Will be set in `tramp-convert-file-attributes'
+ ;; recreated. Will be set in `tramp-convert-file-attributes'.
t
- ;; 10. inode number.
+ ;; 10. Inode number.
res-inode
;; 11. Device number. Will be replaced by a virtual device number.
-1
(tramp-send-command-and-read
vec
(format
- ;; On Opsware, pdksh (which is the true name of ksh there) doesn't
- ;; parse correctly the sequence "((". Therefore, we add a space.
- "( (%s %s || %s -h %s) && %s -c '((\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \"%%A\" t %%ie0 -1)' %s || echo nil)"
+ (concat
+ ;; On Opsware, pdksh (which is the true name of ksh there)
+ ;; doesn't parse correctly the sequence "((". Therefore, we add
+ ;; a space. Apostrophes in the stat output are masked as "//",
+ ;; in order to make a proper shell escape of them in file names.
+ "( (%s %s || %s -h %s) && (%s -c "
+ "'((//%%N//) %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 //%%A// t %%ie0 -1)' "
+ "%s | sed -e 's/\"/\\\\\"/g' -e 's/\\/\\//\"/g') || echo nil)")
(tramp-get-file-exists-command vec)
(tramp-shell-quote-argument localname)
(tramp-get-test-command vec)
(tramp-shell-quote-argument localname)
(tramp-get-remote-stat vec)
- (if (eq id-format 'integer) "%ue0" "\"%U\"")
- (if (eq id-format 'integer) "%ge0" "\"%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)
(defun tramp-sh-handle-directory-files-and-attributes
(directory &optional full match nosort id-format)
"Like `directory-files-and-attributes' for Tramp files."
- (if (with-parsed-tramp-file-name directory nil
- (not (or (tramp-get-remote-stat v) (tramp-get-remote-perl v))))
- (tramp-handle-directory-files-and-attributes
- directory full match nosort id-format)
-
- ;; Do it directly.
- (unless id-format (setq id-format 'integer))
- (when (file-directory-p directory)
- (setq directory (expand-file-name directory))
- (let* ((temp
- (copy-tree
- (with-parsed-tramp-file-name directory nil
- (with-tramp-file-property
- v localname
- (format "directory-files-and-attributes-%s" id-format)
- (save-excursion
- (mapcar
- (lambda (x)
- (cons (car x)
- (tramp-convert-file-attributes v (cdr x))))
- (cond
- ((tramp-get-remote-stat v)
- (tramp-do-directory-files-and-attributes-with-stat
- v localname id-format))
- ((tramp-get-remote-perl v)
- (tramp-do-directory-files-and-attributes-with-perl
- v localname id-format)))))))))
- result item)
-
- (while temp
- (setq item (pop temp))
- (when (or (null match) (string-match match (car item)))
- (when full
- (setcar item (expand-file-name (car item) directory)))
- (push item result)))
-
- (if nosort
- result
- (sort result (lambda (x y) (string< (car x) (car y)))))))))
+ (unless id-format (setq id-format 'integer))
+ (when (file-directory-p directory)
+ (setq directory (expand-file-name directory))
+ (let* ((temp
+ (copy-tree
+ (with-parsed-tramp-file-name directory nil
+ (with-tramp-file-property
+ v localname
+ (format "directory-files-and-attributes-%s" id-format)
+ (save-excursion
+ (mapcar
+ (lambda (x)
+ (cons (car x)
+ (tramp-convert-file-attributes v (cdr x))))
+ (or
+ (cond
+ ((tramp-get-remote-stat v)
+ (tramp-do-directory-files-and-attributes-with-stat
+ v localname id-format))
+ ((tramp-get-remote-perl v)
+ (tramp-do-directory-files-and-attributes-with-perl
+ v localname id-format))
+ (t nil)))))))))
+ result item)
+
+ (while temp
+ (setq item (pop temp))
+ (when (or (null match) (string-match match (car item)))
+ (when full
+ (setcar item (expand-file-name (car item) directory)))
+ (push item result)))
+
+ (or (if nosort
+ result
+ (sort result (lambda (x y) (string< (car x) (car y)))))
+ ;; The scripts could fail, for example with huge file size.
+ (tramp-handle-directory-files-and-attributes
+ directory full match nosort id-format)))))
(defun tramp-do-directory-files-and-attributes-with-perl
(vec localname &optional id-format)
(concat
;; We must care about file names with spaces, or starting with
;; "-"; this would confuse xargs. "ls -aQ" might be a solution,
- ;; but it does not work on all remote systems. Therefore, we
- ;; quote the file names via sed.
- "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | "
+ ;; but it does not work on all remote systems. Apostrophes in
+ ;; the stat output are masked as "//", in order to make a proper
+ ;; shell escape of them in file names.
+ "cd %s && echo \"(\"; (%s %s -a | "
"xargs %s -c "
- "'(\"%%n\" (\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \"%%A\" t %%ie0 -1)'"
- " 2>/dev/null); echo \")\"")
+ "'(//%%n// (//%%N//) %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 //%%A// t %%ie0 -1)' "
+ "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/\\/\\//\"/g'); echo \")\"")
(tramp-shell-quote-argument localname)
(tramp-get-ls-command vec)
+ ;; On systems which have no quoting style, file names with
+ ;; special characters could fail.
+ (if (tramp-get-ls-command-with-quoting-style vec)
+ "--quoting-style=shell" "")
(tramp-get-remote-stat vec)
- (if (eq id-format 'integer) "%ue0" "\"%U\"")
- (if (eq id-format 'integer) "%ge0" "\"%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.
1 0)))
(format (concat
- "(\\cd %s 2>&1 && (%s %s -a 2>/dev/null"
+ "(cd %s 2>&1 && (%s -a %s 2>/dev/null"
;; `ls' with wildcard might fail with `Argument
;; list too long' error in some corner cases; if
;; `ls' fails after `cd' succeeded, chances are
;; sub-directories.
(if (zerop (length filename))
"."
- (concat (tramp-shell-quote-argument filename) "* -d"))
+ (format "-d %s*" (tramp-shell-quote-argument filename)))
(tramp-get-ls-command v)
(tramp-get-test-command v))))
First arg OP is either `copy' or `rename' and indicates the operation.
FILENAME is the source file, NEWNAME the target file.
KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
- (with-temp-buffer
- ;; We must disable multibyte, because binary data shall not be
- ;; converted. We remove `tramp-file-name-handler' from
- ;; `inhibit-file-name-handlers'; otherwise the file name handler
- ;; for `insert-file-contents' might be deactivated in some corner
- ;; cases.
- (set-buffer-multibyte nil)
- (let ((coding-system-for-read 'binary)
- (jka-compr-inhibit t)
- (inhibit-file-name-handlers
- (remq 'tramp-file-name-handler inhibit-file-name-handlers)))
- (insert-file-contents-literally filename))
- ;; We don't want the target file to be compressed, so we let-bind
- ;; `jka-compr-inhibit' to t.
- (let ((coding-system-for-write 'binary)
- (jka-compr-inhibit t))
- (write-region (point-min) (point-max) newname nil 'no-message)))
+ ;; We must disable multibyte, because binary data shall not be
+ ;; converted. We don't want the target file to be compressed, so we
+ ;; let-bind `jka-compr-inhibit' to t.
+ ;; We remove `tramp-file-name-handler' from
+ ;; `inhibit-file-name-handlers'; otherwise the file name handler for
+ ;; `insert-file-contents' might be deactivated in some corner cases.
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
+ (jka-compr-inhibit t)
+ (inhibit-file-name-handlers
+ (remq 'tramp-file-name-handler inhibit-file-name-handlers)))
+ (with-temp-file newname
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally filename)))
;; KEEP-DATE handling.
(when keep-date (set-file-times newname (nth 5 (file-attributes filename))))
;; Set the mode.
spec (format-spec-make
?t (tramp-get-connection-property
(tramp-get-connection-process v) "temp-file" ""))
- options (format-spec
- (if tramp-use-ssh-controlmaster-options
- tramp-ssh-controlmaster-options "")
- spec)
+ options (format-spec (tramp-ssh-controlmaster-options v) spec)
spec (format-spec-make
?h host ?u user ?p port ?r listener ?c options
?k (if keep-date " " ""))
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-directory-property v localname)
(tramp-barf-unless-okay
- v (format "%s %s"
+ v (format "cd / && %s %s"
(if recursive "rm -rf" "rmdir")
(tramp-shell-quote-argument localname))
"Couldn't delete %s" directory)))
(setq uname
(with-tramp-connection-property v uname
(tramp-send-command
- v (format "cd %s; pwd" (tramp-shell-quote-argument uname)))
+ v (format "cd %s && pwd" (tramp-shell-quote-argument uname)))
(with-current-buffer (tramp-get-buffer v)
(goto-char (point-min))
(buffer-substring (point) (point-at-eol)))))
(unwind-protect
(setq ret
(if (tramp-send-command-and-check
- v (format "\\cd %s; %s"
+ v (format "cd %s && %s"
(tramp-shell-quote-argument localname)
command)
t t)
;; If local decoding is a function, we call it.
;; We must disable multibyte, because
;; `uudecode-decode-region' doesn't handle it
- ;; correctly.
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert-buffer-substring (tramp-get-buffer v))
- (funcall loc-dec (point-min) (point-max))
- ;; Unset `file-name-handler-alist'. Otherwise,
- ;; epa-file gets confused.
- (let (file-name-handler-alist
- (coding-system-for-write 'binary))
- (write-region
- (point-min) (point-max) tmpfile nil 'no-message)))
+ ;; correctly. Unset `file-name-handler-alist'.
+ ;; Otherwise, epa-file gets confused.
+ (let (file-name-handler-alist
+ (coding-system-for-write 'binary))
+ (with-temp-file tmpfile
+ (set-buffer-multibyte nil)
+ (insert-buffer-substring (tramp-get-buffer v))
+ (funcall loc-dec (point-min) (point-max))))
;; If tramp-decoding-function is not defined for this
;; method, we invoke tramp-decoding-command instead.
(tramp-get-connection-process vec) "scripts" nil)))
(unless (member name scripts)
(with-tramp-progress-reporter vec 5 (format "Sending script `%s'" name)
+ ;; In bash, leading TABs like in `tramp-vc-registered-read-file-names'
+ ;; could result in unwanted command expansion. Avoid this.
+ (setq script (tramp-compat-replace-regexp-in-string
+ (make-string 1 ?\t) (make-string 8 ? ) script))
;; The script could contain a call of Perl. This is masked with `%s'.
(when (and (string-match "%s" script)
(not (tramp-get-remote-perl vec)))
(tramp-error vec 'file-error "No Perl available on remote host"))
(tramp-barf-unless-okay
vec
- (format "%s () {\n%s\n}" name
- (format script (tramp-get-remote-perl vec)))
+ (format "%s () {\n%s\n}"
+ name (format script (tramp-get-remote-perl vec)))
"Script %s sending failed" name)
(tramp-set-connection-property
(tramp-get-connection-process vec) "scripts" (cons name scripts))))))
(tramp-send-command
vec
(format (concat "while read d; "
- "do if test -x $d/%s -a -f $d/%s; "
+ "do if test -x $d/%s && test -f $d/%s; "
"then echo tramp_executable $d/%s; "
"break; fi; done <<'%s'\n"
"%s\n%s")
;; when called as sh) on startup; this way, we avoid the startup
;; file clobbering $PS1. $PROMPT_COMMAND is another way to set
;; the prompt in /bin/bash, it must be discarded as well.
+ ;; $HISTFILE is set according to `tramp-histfile-override'.
(tramp-send-command
vec (format
- "exec env ENV=''%s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s"
- (if tramp-histfile-override
- (concat " HISTFILE=" tramp-histfile-override)
- "")
+ "exec env ENV='' %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s"
+ (if (stringp tramp-histfile-override)
+ (format "HISTFILE=%s"
+ (tramp-shell-quote-argument tramp-histfile-override))
+ (if tramp-histfile-override
+ "HISTFILE='' HISTFILESIZE=0 HISTSIZE=0"
+ ""))
(tramp-shell-quote-argument tramp-end-of-output)
shell (or extra-args ""))
t))
;; In case the host name is not used for the remote shell
;; command, the user could be misguided by applying a random
- ;; hostname.
+ ;; host name.
(let* ((v (car target-alist))
(method (tramp-file-name-method v))
(host (tramp-file-name-host v)))
;; Result.
target-alist))
+(defun tramp-ssh-controlmaster-options (vec)
+ "Return the Control* arguments of the local ssh."
+ (cond
+ ;; No options to be computed.
+ ((or (null tramp-use-ssh-controlmaster-options)
+ (null (assoc "%c" (tramp-get-method-parameter
+ (tramp-file-name-method vec) 'tramp-login-args))))
+ "")
+
+ ;; There is already a value to be used.
+ ((stringp tramp-ssh-controlmaster-options) tramp-ssh-controlmaster-options)
+
+ ;; Determine the options.
+ (t (setq tramp-ssh-controlmaster-options "")
+ (let ((case-fold-search t))
+ (ignore-errors
+ (when (executable-find "ssh")
+ (with-temp-buffer
+ (tramp-call-process vec "ssh" nil t nil "-o" "ControlMaster")
+ (goto-char (point-min))
+ (when (search-forward-regexp "missing.+argument" nil t)
+ (setq tramp-ssh-controlmaster-options "-o ControlMaster=auto")))
+ (unless (zerop (length tramp-ssh-controlmaster-options))
+ (with-temp-buffer
+ ;; When we use a non-existing host name, we could run
+ ;; into DNS timeouts. So we use "localhost" with an
+ ;; improper port, expecting nobody runs sshd on the
+ ;; telnet port.
+ (tramp-call-process
+ vec "ssh" nil t nil
+ "-p" "23" "-o" "ControlPath=%C" "localhost")
+ (goto-char (point-min))
+ (setq tramp-ssh-controlmaster-options
+ (if (search-forward-regexp "unknown.+key" nil t)
+ (concat tramp-ssh-controlmaster-options
+ " -o ControlPath='tramp.%%r@%%h:%%p'")
+ (concat tramp-ssh-controlmaster-options
+ " -o ControlPath='tramp.%%C'"))))
+ (with-temp-buffer
+ (tramp-call-process vec "ssh" nil t nil "-o" "ControlPersist")
+ (goto-char (point-min))
+ (when (search-forward-regexp "missing.+argument" nil t)
+ (setq tramp-ssh-controlmaster-options
+ (concat tramp-ssh-controlmaster-options
+ " -o ControlPersist=no"))))))))
+ tramp-ssh-controlmaster-options)))
+
(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
(delete-process p))
(setenv "TERM" tramp-terminal-type)
(setenv "LC_ALL" "en_US.utf8")
- (when tramp-histfile-override
- (setenv "HISTFILE" tramp-histfile-override))
+ (if (stringp tramp-histfile-override)
+ (setenv "HISTFILE" tramp-histfile-override)
+ (if tramp-histfile-override
+ (progn
+ (setenv "HISTFILE")
+ (setenv "HISTFILESIZE" "0")
+ (setenv "HISTSIZE" "0"))))
(setenv "PROMPT_COMMAND")
(setenv "PS1" tramp-initial-end-of-output)
(let* ((target-alist (tramp-compute-multi-hops vec))
;; We will apply `tramp-ssh-controlmaster-options'
;; only for the first hop.
- (options (if tramp-use-ssh-controlmaster-options
- tramp-ssh-controlmaster-options ""))
+ (options (tramp-ssh-controlmaster-options vec))
(process-connection-type tramp-process-connection-type)
(process-adaptive-read-buffering nil)
(coding-system-for-read nil)
(with-current-buffer (tramp-get-connection-buffer vec)
(while candidates
(goto-char (point-min))
- (if (string-match (concat "^" (car candidates) "$") (buffer-string))
+ (if (string-match (format "^%s\r?$" (regexp-quote (car candidates)))
+ (buffer-string))
(setq locale (car candidates)
candidates nil)
(setq candidates (cdr candidates)))))
(tramp-send-command-and-check
vec (format "%s --dired -al /dev/null" (tramp-get-ls-command vec))))))
+(defun tramp-get-ls-command-with-quoting-style (vec)
+ (save-match-data
+ (with-tramp-connection-property vec "ls-quoting-style"
+ (tramp-message vec 5 "Checking, whether `ls --quoting-style=shell' works")
+ ;; Some "ls" versions are sensible wrt the order of arguments,
+ ;; they fail when "-al" is after the "--dired" argument (for
+ ;; example on FreeBSD).
+ (tramp-send-command-and-check
+ vec (format "%s --quoting-style=shell -al /dev/null"
+ (tramp-get-ls-command vec))))))
+
(defun tramp-get-test-command (vec)
(with-tramp-connection-property vec "test"
(tramp-message vec 5 "Finding a suitable `test' command")
`(lambda (beg end)
(,coding beg end)
(let ((coding-system-for-write 'binary)
- (coding-system-for-read 'binary))
+ (coding-system-for-read 'binary)
+ (default-directory
+ (tramp-compat-temporary-file-directory)))
(apply
'call-process-region (point-min) (point-max)
(car (split-string ,compress)) t t nil
(cdr (split-string ,compress)))))
`(lambda (beg end)
(let ((coding-system-for-write 'binary)
- (coding-system-for-read 'binary))
+ (coding-system-for-read 'binary)
+ (default-directory
+ (tramp-compat-temporary-file-directory)))
(apply
'call-process-region beg end
(car (split-string ,compress)) t t nil
tramp-smb-method
'((tramp-parse-netrc "~/.netrc"))))
+;;;###tramp-autoload
(defcustom tramp-smb-program "smbclient"
"Name of SMB client to run."
:group 'tramp
:type 'string)
+;;;###tramp-autoload
(defcustom tramp-smb-acl-program "smbcacls"
"Name of SMB acls to run."
:group 'tramp
:type 'string
:version "24.4")
+;;;###tramp-autoload
(defcustom tramp-smb-conf "/dev/null"
"Path of the smb.conf file.
If it is nil, no smb.conf will be added to the `tramp-smb-program'
Operations not mentioned here will be handled by the default Emacs primitives.")
;; Options for remote processes via winexe.
+;;;###tramp-autoload
(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
:type 'string
:version "24.3")
+;;;###tramp-autoload
(defcustom tramp-smb-winexe-shell-command "powershell.exe"
"Shell to be used for processes on remote machines.
This must be Powershell V2 compatible."
:type 'string
:version "24.3")
+;;;###tramp-autoload
(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."
"Edit remote files with a combination of ssh, scp, etc."
:group 'files
:group 'comm
+ :link '(custom-manual "(tramp)Top")
:version "22.1")
;; Maybe we need once a real Tramp mode, with key bindings etc.
`localhost' or the name of the local host. Another host name is
useful only in combination with `tramp-default-proxies-alist'.")
-;;;###tramp-autoload
-(defconst tramp-ssh-controlmaster-options
- (let ((result "")
- (case-fold-search t))
- (ignore-errors
- (with-temp-buffer
- (call-process "ssh" nil t nil "-o" "ControlMaster")
- (goto-char (point-min))
- (when (search-forward-regexp "missing.+argument" nil t)
- (setq result "-o ControlPath=%t.%%r@%%h:%%p -o ControlMaster=auto")))
- (unless (zerop (length result))
- (with-temp-buffer
- (call-process "ssh" nil t nil "-o" "ControlPersist")
- (goto-char (point-min))
- (when (search-forward-regexp "missing.+argument" nil t)
- (setq result (concat result " -o ControlPersist=no"))))))
- result)
- "Call ssh to detect whether it supports the Control* arguments.
-Return a string to be used in `tramp-methods'.")
-
-;;;###tramp-autoload
-(defcustom tramp-use-ssh-controlmaster-options
- (not (zerop (length tramp-ssh-controlmaster-options)))
- "Whether to use `tramp-ssh-controlmaster-options'."
- :group 'tramp
- :version "24.4"
- :type 'boolean)
-
(defcustom tramp-default-method
;; An external copy method seems to be preferred, because it performs
;; much better for large files, and it hasn't too serious delays
(fboundp 'auth-source-search)
;; ssh-agent is running.
(getenv "SSH_AUTH_SOCK")
- (getenv "SSH_AGENT_PID")
- ;; We could reuse the connection.
- (> (length tramp-ssh-controlmaster-options) 0))
+ (getenv "SSH_AGENT_PID"))
"scp"
"ssh"))
;; Fallback.
:type 'string)
(defcustom tramp-login-prompt-regexp
- ".*ogin\\( .*\\)?: *"
+ ".*\\(user\\|login\\)\\( .*\\)?: *"
"Regexp matching login-like prompts.
The regexp should match at end of buffer.
"Load Tramp file name handler, and perform OPERATION."
;; Avoid recursive loading of tramp.el. `temporary-file-directory'
;; does not exist in XEmacs, so we must use something else.
- (let ((default-directory (or (symbol-value 'temporary-file-directory) "/")))
+ (let ((default-directory "/"))
(load "tramp" nil t))
(apply operation args)))
(defun tramp-handle-unhandled-file-name-directory (_filename)
"Like `unhandled-file-name-directory' for Tramp files."
- ;; With Emacs 23, we could simply return `nil'. But we must keep it
- ;; for backward compatibility. "~/" cannot be returned, because
- ;; there might be machines without a HOME directory (like hydra).
- "/")
+ ;; Starting with Emacs 23, we must simply return `nil'. But we must
+ ;; keep backward compatibility, also with XEmacs. "~/" cannot be
+ ;; returned, because there might be machines without a HOME
+ ;; directory (like hydra).
+ (and (< emacs-major-version 23) "/"))
(defun tramp-handle-set-visited-file-modtime (&optional time-list)
"Like `set-visited-file-modtime' for Tramp files."
;; should be changed only there.
;;;###tramp-autoload
-(defconst tramp-version "2.2.11-24.5"
+(defconst tramp-version "2.2.12-pre"
"This version of Tramp.")
;;;###tramp-autoload
(= emacs-major-version 21)
(>= emacs-minor-version 4)))
"ok"
- (format "Tramp 2.2.11-24.5 is not fit for %s"
+ (format "Tramp 2.2.12-pre is not fit for %s"
(when (string-match "^.*$" (emacs-version))
(match-string 0 (emacs-version)))))))
(unless (string-match "\\`ok\\'" x) (error "%s" x)))
(end-of-line 0)
(insert comend))))))))))))
+;;;###autoload
+(defun comment-line (n)
+ "Comment or uncomment current line and leave point after it.
+With positive prefix, apply to N lines including current one.
+With negative prefix, apply to -N lines above. Also, further
+consecutive invocations of this command will inherit the negative
+argument.
+
+If region is active, comment lines in active region instead.
+Unlike `comment-dwim', this always comments whole lines."
+ (interactive "p")
+ (if (use-region-p)
+ (comment-or-uncomment-region
+ (save-excursion
+ (goto-char (region-beginning))
+ (line-beginning-position))
+ (save-excursion
+ (goto-char (region-end))
+ (line-end-position)))
+ (when (and (eq last-command 'comment-line-backward)
+ (natnump n))
+ (setq n (- n)))
+ (let ((range
+ (list (line-beginning-position)
+ (goto-char (line-end-position n)))))
+ (comment-or-uncomment-region
+ (apply #'min range)
+ (apply #'max range)))
+ (forward-line 1)
+ (back-to-indentation)
+ (unless (natnump n) (setq this-command 'comment-line-backward))))
+
(provide 'newcomment)
;;; newcomment.el ends here
;; iswitchb-read-buffer has been written to be a drop in replacement
;; for the normal buffer selection routine `read-buffer'. To use
;; iswitch for all buffer selections in Emacs, add:
-;; (setq read-buffer-function 'iswitchb-read-buffer)
+;; (setq read-buffer-function #'iswitchb-read-buffer)
;; (This variable was introduced in Emacs 20.3.)
;; XEmacs users can get the same behavior by doing:
-;; (defalias 'read-buffer 'iswitchb-read-buffer)
+;; (defalias 'read-buffer #'iswitchb-read-buffer)
;; since `read-buffer' is defined in lisp.
;; Using iswitchb for other completion tasks.
))))
(defun iswitchb-read-buffer (prompt &optional default require-match
- start matches-set)
+ _predicate start matches-set)
"Replacement for the built-in `read-buffer'.
Return the name of a buffer selected.
PROMPT is the prompt to give to the user.
in a table.el table last.
* org.el (org-delete-property): Don't suggest to delete the
- CATEGORY property when the category is not explicitely set in the
+ CATEGORY property when the category is not explicitly set in the
property drawer. Also enforce matching when completing.
(org-insert-heading): Fix regression: with two universal prefixes,
insert heading at the end of the subtree.
2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
* org.el (org-fontify-meta-lines-and-blocks-1):
- Recognize "name" as a valid keyword that can preceed a block.
+ Recognize "name" as a valid keyword that can precede a block.
2012-01-03 Eric Schulte <schulte.eric@gmail.com>
(save-excursion
(outline-back-to-heading t)
(outline-flag-region (1- (point))
- (progn (outline-next-preface) (point)) nil)))
+ (progn
+ (outline-next-preface)
+ (if (= 1 (- (point-max) (point)))
+ (point-max)
+ (point)))
+ nil)))
(define-obsolete-function-alias
'show-entry 'outline-show-entry "25.1")
(while (re-search-forward (concat "^ *" host-re) nil t)
(add-to-list 'ssh-hosts-list (concat (match-string 1)
(match-string 2)))
- (while (and (looking-back ",")
+ (while (and (eq (char-before) ?,)
(re-search-forward host-re (line-end-position) t))
(add-to-list 'ssh-hosts-list (concat (match-string 1)
(match-string 2)))))
;; `gamegrid-add-score' was supposed to be used in the past and
;; is covered here for backward-compatibility.
;;
-;; 2. The helper program "update-game-score" is setuid and the
-;; file FILE does already exist in a system wide shared game
-;; directory. This should be the normal case on POSIX systems,
-;; if the game was installed system wide. Use
+;; 2. The helper program "update-game-score" is setgid or setuid
+;; and the file FILE does already exist in a system wide shared
+;; game directory. This should be the normal case on POSIX
+;; systems, if the game was installed system wide. Use
;; "update-game-score" to add the score to the file in the
;; shared game directory.
;;
-;; 3. "update-game-score" is setuid, but the file FILE does *not*
-;; exist in the system wide shared game directory. Use
+;; 3. "update-game-score" is setgid/setuid, but the file FILE does
+;; *not* exist in the system wide shared game directory. Use
;; `gamegrid-add-score-insecure' to create--if necessary--and
;; update FILE. This is for the case that a user has installed
;; a game on her own.
;;
-;; 4. "update-game-score" is not setuid. Use it to create/update
-;; FILE in the user's home directory. There is presumably no
-;; shared game directory.
+;; 4. "update-game-score" is not setgid/setuid. Use it to
+;; create/update FILE in the user's home directory. There is
+;; presumably no shared game directory.
(defvar gamegrid-shared-game-dir)
(gamegrid-add-score-insecure file score))
((and gamegrid-shared-game-dir
(file-exists-p (expand-file-name file shared-game-score-directory)))
- ;; Use the setuid (or setgid) "update-game-score" program
+ ;; Use the setgid (or setuid) "update-game-score" program
;; to update a system-wide score file.
(gamegrid-add-score-with-update-game-score-1 file
(expand-file-name file shared-game-score-directory) score))
(while
;; Add an element to `c-state-nonlit-pos-cache' each iteration.
(and
- (<= (setq npos (+ pos c-state-nonlit-pos-interval)) here)
+ (setq npos
+ (when (<= (+ pos c-state-nonlit-pos-interval) here)
+ (+ pos c-state-nonlit-pos-interval)))
;; Test for being in a literal. If so, go to after it.
(progn
;; Add one extra element above HERE so as to to avoid the previous
;; expensive calculation when the next call is close to the current
;; one. This is especially useful when inside a large macro.
- (setq c-state-nonlit-pos-cache (cons npos c-state-nonlit-pos-cache)))
+ (when npos
+ (setq c-state-nonlit-pos-cache
+ (cons npos c-state-nonlit-pos-cache))))
(if (> pos c-state-nonlit-pos-cache-limit)
(setq c-state-nonlit-pos-cache-limit pos))
(setq dropped-cons (consp (car c-state-cache)))
(setq c-state-cache (cdr c-state-cache))
(setq pos pa))
- ;; At this stage, (> pos here);
+ ;; At this stage, (>= pos here);
;; (< (c-state-cache-top-lparen) here) (or is nil).
(cond
(c-lang-defconst c-before-font-lock-functions
;; For documentation see the following c-lang-defvar of the same name.
;; The value here may be a list of functions or a single function.
- t 'c-change-set-fl-decl-start
+ t 'c-change-expand-fl-region
(c c++ objc) '(c-neutralize-syntax-in-and-mark-CPP
- c-change-set-fl-decl-start)
+ c-change-expand-fl-region)
awk 'c-awk-extend-and-syntax-tablify-region)
(c-lang-defvar c-before-font-lock-functions
(let ((fs (c-lang-const c-before-font-lock-functions)))
(c-lang-defconst c-before-context-fontification-functions
awk nil
- t 'c-context-set-fl-decl-start)
+ t 'c-context-expand-fl-region)
;; For documentation see the following c-lang-defvar of the same name.
;; The value here may be a list of functions or a single function.
(c-lang-defvar c-before-context-fontification-functions
(let ((pps-position (point)) pps-state mbeg)
(while (and (< (point) c-new-END)
(search-forward-regexp c-anchored-cpp-prefix c-new-END t))
- ;; If we've found a "#" inside a string/comment, ignore it.
- (setq pps-state
- (parse-partial-sexp pps-position (point) nil nil pps-state)
- pps-position (point))
- (unless (or (nth 3 pps-state) ; in a string?
- (nth 4 pps-state)) ; in a comment?
+ ;; If we've found a "#" inside a macro/string/comment, ignore it.
+ (unless
+ (or (save-excursion
+ (goto-char (match-beginning 0))
+ (c-beginning-of-macro))
+ (progn
+ (setq pps-state
+ (parse-partial-sexp pps-position (point) nil nil pps-state)
+ pps-position (point))
+ (or (nth 3 pps-state) ; in a string?
+ (nth 4 pps-state)))) ; in a comment?
(goto-char (match-beginning 1))
(setq mbeg (point))
(if (> (c-syntactic-end-of-macro) mbeg)
(funcall fn beg end old-len))
c-before-font-lock-functions))))))
-(defun c-set-fl-decl-start (pos)
+(defun c-fl-decl-start (pos)
;; If the beginning of the line containing POS is in the middle of a "local"
;; declaration (i.e. one which does not start outside of braces enclosing
;; POS, such as a struct), return the beginning of that declaration.
- ;; Otherwise return POS. Note that declarations, in this sense, can be
+ ;; Otherwise return nil. Note that declarations, in this sense, can be
;; nested.
;;
;; This function is called indirectly from font locking stuff - either from
(1- (point)) 'syntax-table)
c-<-as-paren-syntax)))))
(not (bobp)))
- (backward-char))
- new-pos)) ; back over (, [, <.
-
-(defun c-change-set-fl-decl-start (_beg _end _old-len)
- ;; Set c-new-BEG to the beginning of a "local" declaration if it('s BOL) is
- ;; inside one. This is called from an after-change-function, but the
- ;; parameters BEG END and OLD-LEN are ignored. See `c-set-fl-decl-start'
- ;; for the detailed functionality.
- (if font-lock-mode
- (setq c-new-BEG (c-set-fl-decl-start c-new-BEG))))
-
-(defun c-context-set-fl-decl-start (beg end)
- ;; Return a cons (NEW-BEG . END), where NEW-BEG is the beginning of a
- ;; "local" declaration (BOL at) NEW is inside or BEG. See
- ;; `c-set-fl-decl-start' for the detailed functionality.
- (cons (c-set-fl-decl-start beg) end))
+ (backward-char)) ; back over (, [, <.
+ (and (/= new-pos pos) new-pos)))
+
+(defun c-change-expand-fl-region (beg end old-len)
+ ;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock
+ ;; region. This will usually be the smallest sequence of whole lines
+ ;; containing `c-new-BEG' and `c-new-END', but if `c-new-BEG' is in a
+ ;; "local" declaration (see `c-fl-decl-start') the beginning of this is used
+ ;; as the lower bound.
+ ;;
+ ;; This is called from an after-change-function, but the parameters BEG END
+ ;; and OLD-LEN are not used.
+ (if font-lock-mode
+ (setq c-new-BEG
+ (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG))
+ c-new-END (c-point 'bonl c-new-END))))
+
+(defun c-context-expand-fl-region (beg end)
+ ;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a
+ ;; "local" declaration containing BEG (see `c-fl-decl-start') or BOL BEG is
+ ;; in. NEW-END is beginning of the line after the one END is in.
+ (cons (or (c-fl-decl-start beg) (c-point 'bol beg))
+ (c-point 'bonl end)))
+
+(defun c-before-context-fl-expand-region (beg end)
+ ;; Expand the region (BEG END) as specified by
+ ;; `c-before-context-fontification-functions'. Return a cons of the bounds
+ ;; of the new region.
+ (save-restriction
+ (widen)
+ (save-excursion
+ (let ((new-beg beg) (new-end end) new-region)
+ (mapc (lambda (fn)
+ (setq new-region (funcall fn new-beg new-end))
+ (setq new-beg (car new-region) new-end (cdr new-region)))
+ c-before-context-fontification-functions)
+ new-region))))
(defun c-font-lock-fontify-region (beg end &optional verbose)
;; Effectively advice around `font-lock-fontify-region' which extends the
;; region (BEG END), for example, to avoid context fontification chopping
- ;; off the start of the context. Do not do anything if it's already been
- ;; done (i.e. from an after-change fontification. An example (C++) where
- ;; this used to happen is this:
+ ;; off the start of the context. Do not extend the region if it's already
+ ;; been done (i.e. from an after-change fontification. An example (C++)
+ ;; where the chopping off used to happen is this:
;;
;; template <typename T>
;;
;;
;; Type a space in the first blank line, and the fontification of the next
;; line was fouled up by context fontification.
- (let ((new-beg beg) (new-end end) new-region case-fold-search
- open-paren-in-column-0-is-defun-start)
- (if c-in-after-change-fontification
- (setq c-in-after-change-fontification nil)
- (save-restriction
- (widen)
- (save-excursion
- (mapc (lambda (fn)
- (setq new-region (funcall fn new-beg new-end))
- (setq new-beg (car new-region) new-end (cdr new-region)))
- c-before-context-fontification-functions))))
+ (let (new-beg new-end new-region case-fold-search
+ open-paren-in-column-0-is-defun-start)
+ (if (and c-in-after-change-fontification
+ (< beg c-new-END) (> end c-new-BEG))
+ ;; Region and the latest after-change fontification region overlap.
+ ;; Determine the upper and lower bounds of our adjusted region
+ ;; separately.
+ (progn
+ (if (<= beg c-new-BEG)
+ (setq c-in-after-change-fontification nil))
+ (setq new-beg
+ (if (and (>= beg (c-point 'bol c-new-BEG))
+ (<= beg c-new-BEG))
+ ;; Either jit-lock has accepted `c-new-BEG', or has
+ ;; (probably) extended the change region spuriously to
+ ;; BOL, which position likely has a syntactically
+ ;; different position. To ensure correct fontification,
+ ;; we start at `c-new-BEG', assuming any characters to the
+ ;; left of `c-new-BEG' on the line do not require
+ ;; fontification.
+ c-new-BEG
+ (setq new-region (c-before-context-fl-expand-region beg end)
+ new-end (cdr new-region))
+ (car new-region)))
+ (setq new-end
+ (if (and (>= end (c-point 'bol c-new-END))
+ (<= end c-new-END))
+ c-new-END
+ (or new-end
+ (cdr (c-before-context-fl-expand-region beg end))))))
+ ;; Context (etc.) fontification.
+ (setq new-region (c-before-context-fl-expand-region beg end)
+ new-beg (car new-region) new-end (cdr new-region)))
(funcall (default-value 'font-lock-fontify-region-function)
new-beg new-end verbose)))
;; Emacs 22 and later.
(defun c-extend-after-change-region (_beg _end _old-len)
"Extend the region to be fontified, if necessary."
- ;; Note: the parameters are ignored here. This somewhat indirect
+ ;; Note: the parameter OLD-LEN is ignored here. This somewhat indirect
;; implementation exists because it is minimally different from the
;; stand-alone CC Mode which, lacking
;; font-lock-extend-after-change-region-function, is forced to use advice
;; Of the seven CC Mode languages, currently (2009-05) only C, C++, Objc
;; (the languages with #define) and AWK Mode make non-null use of this
;; function.
+ (when (eq font-lock-support-mode 'jit-lock-mode)
+ (save-restriction
+ (widen)
+ (if (< c-new-BEG beg)
+ (put-text-property c-new-BEG beg 'fontified nil))
+ (if (> c-new-END end)
+ (put-text-property end c-new-END 'fontified nil))))
(cons c-new-BEG c-new-END))
;; Emacs < 22 and XEmacs
(search-backward ")")
(if (eq last-command-event ?\()
(progn ; Avoid "if (())"
- (delete-backward-char 1)
- (delete-backward-char -1))))
+ (delete-char -1)
+ (delete-char 1))))
(if delete
(cperl-putback-char cperl-del-back-ch))
(if cperl-message-electric-keyword
(delete-region (point) p))
(if cperl-electric-backspace-untabify
(backward-delete-char-untabify arg)
- (delete-backward-char arg)))))
+ (call-interactively 'delete-backward-char)))))
(put 'cperl-electric-backspace 'delete-selection 'supersede)
(defun elisp--eval-last-sexp (eval-last-sexp-arg-internal)
"Evaluate sexp before point; print value in the echo area.
-With argument, print output into current buffer.
-With a zero prefix arg, print output with no limit on the length
-and level of lists, and include additional formats for integers
-\(octal, hexadecimal, and character)."
+If EVAL-LAST-SEXP-ARG-INTERNAL is non-nil, print output into
+current buffer. If EVAL-LAST-SEXP-ARG-INTERNAL is `0', print
+output with no limit on the length and level of lists, and
+include additional formats for integers \(octal, hexadecimal, and
+character)."
(let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
;; Setup the lexical environment if lexical-binding is enabled.
(elisp--eval-last-sexp-print-value
"final" "generic" "import" "non_intrinsic" "non_overridable"
"nopass" "pass" "protected" "same_type_as" "value" "volatile"
;; F2008.
+ ;; FIXME f90-change-keywords does not work right if
+ ;; there are spaces.
"contiguous" "submodule" "concurrent" "codimension"
- "sync all" "sync memory" "critical" "image_index"
+ "sync all" "sync memory" "critical" "image_index" "error stop"
))
"\\_>")
"Regexp used by the function `f90-change-keywords'.")
"norm2" "parity" "findloc" "is_contiguous"
"sync images" "lock" "unlock" "image_index"
"lcobound" "ucobound" "num_images" "this_image"
+ "acosh" "asinh" "atanh"
+ "atomic_define" "atomic_ref" "execute_command_line"
;; F2008 iso_fortran_env module.
"compiler_options" "compiler_version"
;; F2008 iso_c_binding module.
(1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
"\\_<else\\([ \t]*if\\|where\\)?\\_>"
'("\\(&\\)[ \t]*\\(!\\|$\\)" (1 font-lock-keyword-face))
- "\\_<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\_>"
+ "\\_<\\(then\\|continue\\|format\\|include\\|\\(?:error[ \t]+\\)?stop\\|\
+return\\)\\_>"
'("\\_<\\(exit\\|cycle\\)[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?\\_>"
(1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
'("\\_<\\(case\\)[ \t]*\\(default\\|(\\)" . 1)
(re-search-backward f90-program-block-re nil 'move))
(beginning-of-line)
(skip-chars-forward " \t0-9")
- (cond ((setq matching-beg (f90-looking-at-program-block-start))
+ ;; Check if in string in case using non-standard feature where
+ ;; continued strings do not need "&" at start of continuations.
+ (cond ((f90-in-string))
+ ((setq matching-beg (f90-looking-at-program-block-start))
(setq count (1- count)))
((f90-looking-at-program-block-end)
(setq count (1+ count)))))
(re-search-forward f90-program-block-re nil 'move))
(beginning-of-line)
(skip-chars-forward " \t0-9")
- (cond ((f90-looking-at-program-block-start)
+ (cond ((f90-in-string))
+ ((f90-looking-at-program-block-start)
(setq count (1+ count)))
((setq matching-end (f90-looking-at-program-block-end))
(setq count (1- count))))
(end-point (point))
(case-fold-search t)
matching-beg beg-name end-name beg-block end-block end-struct)
+ ;; Check if in string in case using non-standard feature where
+ ;; continued strings do not need "&" at start of continuations.
(when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")
- (setq end-struct (f90-looking-at-program-block-end)))
+ (unless (f90-in-string)
+ (setq end-struct
+ (f90-looking-at-program-block-end))))
(setq end-block (car end-struct)
end-name (cadr end-struct))
(save-excursion
(skip-chars-forward " \t0-9")
(looking-at "#"))))
(setq ref-point (point)
+ ;; FIXME this does not work for constructs with
+ ;; embedded space, eg "sync all".
back-point (save-excursion (backward-word 1) (point))
saveword (buffer-substring back-point ref-point))
(funcall change-word -1)
:syntax-table nil :abbrev-table nil
(make-comint-in-buffer "gdb-inferior" (current-buffer) nil))
+(defcustom gdb-display-io-nopopup nil
+ "When non-nil, and the 'gdb-inferior-io buffer is buried, don't pop it up."
+ :type 'boolean
+ :group 'gdb
+ :version "25.1")
+
(defun gdb-inferior-filter (proc string)
(unless (string-equal string "")
- (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io)))
+ (let (buf)
+ (unless (and gdb-display-io-nopopup
+ (setq buf (gdb-get-buffer 'gdb-inferior-io))
+ (null (get-buffer-window buf)))
+ (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)))
-;;; gud.el --- Grand Unified Debugger mode for running GDB and other debuggers
+;;; gud.el --- Grand Unified Debugger mode for running GDB and other debuggers -*- lexical-binding:t -*-
;; Copyright (C) 1992-1996, 1998, 2000-2015 Free Software Foundation,
;; Inc.
(gud-find-file true-file)))
(window (and buffer
(or (get-buffer-window buffer)
- (display-buffer buffer))))
+ (display-buffer buffer '(nil (inhibit-same-window . t))))))
(pos))
(when buffer
(with-current-buffer buffer
:type 'integer
:group 'js)
+(defcustom js-indent-first-init nil
+ "Non-nil means specially indent the first variable declaration's initializer.
+Normally, the first declaration's initializer is unindented, and
+subsequent declarations have their identifiers aligned with it:
+
+ var o = {
+ foo: 3
+ };
+
+ var o = {
+ foo: 3
+ },
+ bar = 2;
+
+If this option has the value t, indent the first declaration's
+initializer by an additional level:
+
+ var o = {
+ foo: 3
+ };
+
+ var o = {
+ foo: 3
+ },
+ bar = 2;
+
+If this option has the value `dynamic', if there is only one declaration,
+don't indent the first one's initializer; otherwise, indent it.
+
+ var o = {
+ foo: 3
+ };
+
+ var o = {
+ foo: 3
+ },
+ bar = 2;"
+ :version "25.1"
+ :type '(choice (const nil) (const t) (const dynamic))
+ :safe 'symbolp
+ :group 'js)
+
;;; KeyMap
(defvar js-mode-map
(let ((table (make-syntax-table)))
(c-populate-syntax-table table)
(modify-syntax-entry ?$ "_" table)
+ (modify-syntax-entry ?` "\"" table)
table)
"Syntax table for `js-mode'.")
(goto-char for-kwd)
(current-column))))
+(defun js--maybe-goto-declaration-keyword-end (parse-status)
+ "Helper function for `js--proper-indentation'.
+Depending on the value of `js-indent-first-init', move
+point to the end of a variable declaration keyword so that
+indentation is aligned to that column."
+ (cond
+ ((eq js-indent-first-init t)
+ (when (looking-at js--declaration-keyword-re)
+ (goto-char (1+ (match-end 0)))))
+ ((eq js-indent-first-init 'dynamic)
+ (let ((bracket (nth 1 parse-status))
+ declaration-keyword-end
+ at-closing-bracket-p
+ comma-p)
+ (when (looking-at js--declaration-keyword-re)
+ (setq declaration-keyword-end (match-end 0))
+ (save-excursion
+ (goto-char bracket)
+ (setq at-closing-bracket-p
+ (condition-case nil
+ (progn
+ (forward-sexp)
+ t)
+ (error nil)))
+ (when at-closing-bracket-p
+ (while (forward-comment 1))
+ (setq comma-p (looking-at-p ","))))
+ (when comma-p
+ (goto-char (1+ declaration-keyword-end))))))))
+
(defun js--proper-indentation (parse-status)
"Return the proper indentation for the current line."
(save-excursion
(skip-syntax-backward " ")
(when (eq (char-before) ?\)) (backward-list))
(back-to-indentation)
+ (js--maybe-goto-declaration-keyword-end parse-status)
(let* ((in-switch-p (unless same-indent-p
(looking-at "\\_<switch\\_>")))
(same-indent-p (or same-indent-p
(let* ((parse-status
(save-excursion (syntax-ppss (point-at-bol))))
(offset (- (point) (save-excursion (back-to-indentation) (point)))))
- (indent-line-to (js--proper-indentation parse-status))
- (when (> offset 0) (forward-char offset))))
+ (unless (nth 3 parse-status)
+ (indent-line-to (js--proper-indentation parse-status))
+ (when (> offset 0) (forward-char offset)))))
;;; Filling
;; Author: Fabián E. Gallina <fabian@anue.biz>
;; URL: https://github.com/fgallina/python.el
-;; Version: 0.24.4
+;; Version: 0.24.5
;; Maintainer: emacs-devel@gnu.org
;; Created: Jul 2010
;; Keywords: languages
:group 'python
:safe 'booleanp)
+(defcustom python-indent-guess-indent-offset-verbose t
+ "Non-nil means to emit a warning when indentation guessing fails."
+ :type 'boolean
+ :group 'python
+ :safe' booleanp)
+
(defcustom python-indent-trigger-commands
'(indent-for-tab-command yas-expand yas/expand)
"Commands that might trigger a `python-indent-line' call."
(current-indentation))))
(if (and indentation (not (zerop indentation)))
(set (make-local-variable 'python-indent-offset) indentation)
- (message "Can't guess python-indent-offset, using defaults: %s"
- python-indent-offset)))))))
+ (when python-indent-guess-indent-offset-verbose
+ (message "Can't guess python-indent-offset, using defaults: %s"
+ python-indent-offset))))))))
(defun python-indent-context ()
"Get information about the current indentation context.
;; Beginning of buffer.
((= (line-number-at-pos) 1)
(cons :no-indent 0))
- ;; Comment continuation (maybe).
- ((save-excursion
- (when (and
- (or
- (python-info-current-line-comment-p)
- (python-info-current-line-empty-p))
- (forward-comment -1)
- (python-info-current-line-comment-p))
- (cons :after-comment (point)))))
;; Inside a string.
((let ((start (python-syntax-context 'string ppss)))
(when start
((let ((start (python-info-dedenter-statement-p)))
(when start
(cons :at-dedenter-block-start start))))
- ;; After normal line.
- ((let ((start (save-excursion
- (back-to-indentation)
- (skip-chars-backward " \t\n")
- (python-nav-beginning-of-statement)
- (point))))
- (when start
- (if (save-excursion
- (python-util-forward-comment -1)
- (python-nav-beginning-of-statement)
- (looking-at (python-rx block-ender)))
- (cons :after-block-end start)
- (cons :after-line start)))))
- ;; Default case: do not indent.
- (t (cons :no-indent 0))))))
+ ;; After normal line, comment or ender (default case).
+ ((save-excursion
+ (back-to-indentation)
+ (skip-chars-backward " \t\n")
+ (python-nav-beginning-of-statement)
+ (cons
+ (cond ((python-info-current-line-comment-p)
+ :after-comment)
+ ((save-excursion
+ (goto-char (line-end-position))
+ (python-util-forward-comment -1)
+ (python-nav-beginning-of-statement)
+ (looking-at (python-rx block-ender)))
+ :after-block-end)
+ (t :after-line))
+ (point))))))))
(defun python-indent--calculate-indentation ()
"Internal implementation of `python-indent-calculate-indentation'.
May return an integer for the maximum possible indentation at
current context or a list of integers. The latter case is only
happening for :at-dedenter-block-start context since the
-possibilities can be narrowed to especific indentation points."
+possibilities can be narrowed to specific indentation points."
(save-restriction
(widen)
(save-excursion
(levels (python-indent--calculate-levels indentation)))
(if previous
(python-indent--previous-level levels (current-indentation))
- (apply #'max levels))))
+ (if levels
+ (apply #'max levels)
+ 0))))
(defun python-indent-line (&optional previous)
"Internal implementation of `python-indent-line-function'.
Use the PREVIOUS level when argument is non-nil, otherwise indent
-to the maxium available level. When indentation is the minimum
+to the maximum available level. When indentation is the minimum
possible and PREVIOUS is non-nil, cycle back to the maximum
level."
(let ((follow-indentation-p
(interactive "*")
(when (and (not (bolp))
(not (python-syntax-comment-or-string-p))
- (= (+ (line-beginning-position)
- (current-indentation))
- (point)))
+ (= (current-indentation) (current-column)))
(python-indent-line t)
t))
(let ((process-name
(process-name (get-buffer-process (current-buffer)))))
(generate-new-buffer
- (format "*%s-font-lock*" process-name))))))
+ (format " *%s-font-lock*" process-name))))))
(defun python-shell-font-lock-kill-buffer ()
"Kill the font-lock buffer safely."
- (python-shell-with-shell-buffer
- (when (and python-shell--font-lock-buffer
- (buffer-live-p python-shell--font-lock-buffer))
- (kill-buffer python-shell--font-lock-buffer)
- (when (derived-mode-p 'inferior-python-mode)
- (setq python-shell--font-lock-buffer nil)))))
+ (when (and python-shell--font-lock-buffer
+ (buffer-live-p python-shell--font-lock-buffer))
+ (kill-buffer python-shell--font-lock-buffer)
+ (when (derived-mode-p 'inferior-python-mode)
+ (setq python-shell--font-lock-buffer nil))))
(defmacro python-shell-font-lock-with-font-lock-buffer (&rest body)
"Execute the forms in BODY in the font-lock buffer.
(setq python-shell--font-lock-buffer
(python-shell-font-lock-get-or-create-buffer)))
(set-buffer python-shell--font-lock-buffer)
+ (when (not font-lock-mode)
+ (font-lock-mode 1))
(set (make-local-variable 'delay-mode-hooks) t)
(let ((python-indent-guess-indent-offset nil))
(when (not (derived-mode-p 'python-mode))
(interactive)
(python-shell-with-shell-buffer
(python-shell-font-lock-with-font-lock-buffer
- (delete-region (point-min) (point-max)))))
+ (erase-buffer))))
(defun python-shell-font-lock-comint-output-filter-function (output)
"Clean up the font-lock buffer after any OUTPUT."
- (when (and (not (string= "" output))
- ;; Is end of output and is not just a prompt.
- (not (member
- (python-shell-comint-end-of-output-p
- (ansi-color-filter-apply output))
- '(nil 0))))
- ;; If output is other than an input prompt then "real" output has
- ;; been received and the font-lock buffer must be cleaned up.
- (python-shell-font-lock-cleanup-buffer))
+ (if (and (not (string= "" output))
+ ;; Is end of output and is not just a prompt.
+ (not (member
+ (python-shell-comint-end-of-output-p
+ (ansi-color-filter-apply output))
+ '(nil 0))))
+ ;; If output is other than an input prompt then "real" output has
+ ;; been received and the font-lock buffer must be cleaned up.
+ (python-shell-font-lock-cleanup-buffer)
+ ;; Otherwise just add a newline.
+ (python-shell-font-lock-with-font-lock-buffer
+ (goto-char (point-max))
+ (newline)))
output)
(defun python-shell-font-lock-post-command-hook ()
"Fontifies current line in shell buffer."
- (if (eq this-command 'comint-send-input)
- ;; Add a newline when user sends input as this may be a block.
- (python-shell-font-lock-with-font-lock-buffer
- (goto-char (line-end-position))
- (newline))
- (when (and (python-util-comint-last-prompt)
- (> (point) (cdr (python-util-comint-last-prompt))))
- (let ((input (buffer-substring-no-properties
- (cdr (python-util-comint-last-prompt)) (point-max)))
- (old-input (python-shell-font-lock-with-font-lock-buffer
- (buffer-substring-no-properties
- (line-beginning-position) (point-max))))
- (current-point (point))
- (buffer-undo-list t))
- ;; When input hasn't changed, do nothing.
- (when (not (string= input old-input))
- (delete-region (cdr (python-util-comint-last-prompt)) (point-max))
- (insert
- (python-shell-font-lock-with-font-lock-buffer
- (delete-region (line-beginning-position)
- (line-end-position))
- (insert input)
- ;; Ensure buffer is fontified, keeping it
- ;; compatible with Emacs < 24.4.
- (if (fboundp 'font-lock-ensure)
- (funcall 'font-lock-ensure)
- (font-lock-default-fontify-buffer))
- ;; Replace FACE text properties with FONT-LOCK-FACE so
- ;; they are not overwritten by comint buffer's font lock.
- (python-util-text-properties-replace-name
- 'face 'font-lock-face)
- (buffer-substring (line-beginning-position)
- (line-end-position))))
- (goto-char current-point))))))
+ (let ((prompt-end (cdr (python-util-comint-last-prompt))))
+ (when (and prompt-end (> (point) prompt-end)
+ (process-live-p (get-buffer-process (current-buffer))))
+ (let* ((input (buffer-substring-no-properties
+ prompt-end (point-max)))
+ (deactivate-mark nil)
+ (start-pos prompt-end)
+ (buffer-undo-list t)
+ (font-lock-buffer-pos nil)
+ (replacement
+ (python-shell-font-lock-with-font-lock-buffer
+ (delete-region (line-beginning-position)
+ (point-max))
+ (setq font-lock-buffer-pos (point))
+ (insert input)
+ ;; Ensure buffer is fontified, keeping it
+ ;; compatible with Emacs < 24.4.
+ (if (fboundp 'font-lock-ensure)
+ (funcall 'font-lock-ensure)
+ (font-lock-default-fontify-buffer))
+ (buffer-substring font-lock-buffer-pos
+ (point-max))))
+ (replacement-length (length replacement))
+ (i 0))
+ ;; Inject text properties to get input fontified.
+ (while (not (= i replacement-length))
+ (let* ((plist (text-properties-at i replacement))
+ (next-change (or (next-property-change i replacement)
+ replacement-length))
+ (plist (let ((face (plist-get plist 'face)))
+ (if (not face)
+ plist
+ ;; Replace FACE text properties with
+ ;; FONT-LOCK-FACE so input is fontified.
+ (plist-put plist 'face nil)
+ (plist-put plist 'font-lock-face face)))))
+ (set-text-properties
+ (+ start-pos i) (+ start-pos next-change) plist)
+ (setq i next-change)))))))
(defun python-shell-font-lock-turn-on (&optional msg)
"Turn on shell font-lock.
'(face nil font-lock-face nil)))
(set (make-local-variable 'python-shell--font-lock-buffer) nil)
(remove-hook 'post-command-hook
- #'python-shell-font-lock-post-command-hook'local)
+ #'python-shell-font-lock-post-command-hook 'local)
(remove-hook 'kill-buffer-hook
#'python-shell-font-lock-kill-buffer 'local)
(remove-hook 'comint-output-filter-functions
"Get completions using native readline for PROCESS.
When IMPORT is non-nil takes precedence over INPUT for
completion."
- (when (and python-shell-completion-native-enable
- (python-util-comint-last-prompt)
- (>= (point) (cdr (python-util-comint-last-prompt))))
- (let* ((input (or import input))
- (original-filter-fn (process-filter process))
- (redirect-buffer (get-buffer-create
- python-shell-completion-native-redirect-buffer))
- (separators (python-rx
- (or whitespace open-paren close-paren)))
- (trigger "\t\t\t")
- (new-input (concat input trigger))
- (input-length
- (save-excursion
- (+ (- (point-max) (comint-bol)) (length new-input))))
- (delete-line-command (make-string input-length ?\b))
- (input-to-send (concat new-input delete-line-command)))
- ;; Ensure restoring the process filter, even if the user quits
- ;; or there's some other error.
- (unwind-protect
- (with-current-buffer redirect-buffer
- ;; Cleanup the redirect buffer
- (delete-region (point-min) (point-max))
- ;; Mimic `comint-redirect-send-command', unfortunately it
- ;; can't be used here because it expects a newline in the
- ;; command and that's exactly what we are trying to avoid.
- (let ((comint-redirect-echo-input nil)
- (comint-redirect-verbose nil)
- (comint-redirect-perform-sanity-check nil)
- (comint-redirect-insert-matching-regexp nil)
- ;; Feed it some regex that will never match.
- (comint-redirect-finished-regexp "^\\'$")
- (comint-redirect-output-buffer redirect-buffer))
- ;; Compatibility with Emacs 24.x. Comint changed and
- ;; now `comint-redirect-filter' gets 3 args. This
- ;; checks which version of `comint-redirect-filter' is
- ;; in use based on its args and uses `apply-partially'
- ;; to make it up for the 3 args case.
- (if (= (length
- (help-function-arglist 'comint-redirect-filter)) 3)
- (set-process-filter
- process (apply-partially
- #'comint-redirect-filter original-filter-fn))
- (set-process-filter process #'comint-redirect-filter))
- (process-send-string process input-to-send)
- (accept-process-output
- process
- python-shell-completion-native-output-timeout)
- ;; XXX: can't use `python-shell-accept-process-output'
- ;; here because there are no guarantees on how output
- ;; ends. The workaround here is to call
- ;; `accept-process-output' until we don't find anything
- ;; else to accept.
- (while (accept-process-output
- process
- python-shell-completion-native-output-timeout))
- (cl-remove-duplicates
- (split-string
- (buffer-substring-no-properties
- (point-min) (point-max))
- separators t))))
- (set-process-filter process original-filter-fn)))))
+ (with-current-buffer (process-buffer process)
+ (when (and python-shell-completion-native-enable
+ (python-util-comint-last-prompt)
+ (>= (point) (cdr (python-util-comint-last-prompt))))
+ (let* ((input (or import input))
+ (original-filter-fn (process-filter process))
+ (redirect-buffer (get-buffer-create
+ python-shell-completion-native-redirect-buffer))
+ (separators (python-rx
+ (or whitespace open-paren close-paren)))
+ (trigger "\t\t\t")
+ (new-input (concat input trigger))
+ (input-length
+ (save-excursion
+ (+ (- (point-max) (comint-bol)) (length new-input))))
+ (delete-line-command (make-string input-length ?\b))
+ (input-to-send (concat new-input delete-line-command)))
+ ;; Ensure restoring the process filter, even if the user quits
+ ;; or there's some other error.
+ (unwind-protect
+ (with-current-buffer redirect-buffer
+ ;; Cleanup the redirect buffer
+ (delete-region (point-min) (point-max))
+ ;; Mimic `comint-redirect-send-command', unfortunately it
+ ;; can't be used here because it expects a newline in the
+ ;; command and that's exactly what we are trying to avoid.
+ (let ((comint-redirect-echo-input nil)
+ (comint-redirect-verbose nil)
+ (comint-redirect-perform-sanity-check nil)
+ (comint-redirect-insert-matching-regexp nil)
+ ;; Feed it some regex that will never match.
+ (comint-redirect-finished-regexp "^\\'$")
+ (comint-redirect-output-buffer redirect-buffer))
+ ;; Compatibility with Emacs 24.x. Comint changed and
+ ;; now `comint-redirect-filter' gets 3 args. This
+ ;; checks which version of `comint-redirect-filter' is
+ ;; in use based on its args and uses `apply-partially'
+ ;; to make it up for the 3 args case.
+ (if (= (length
+ (help-function-arglist 'comint-redirect-filter)) 3)
+ (set-process-filter
+ process (apply-partially
+ #'comint-redirect-filter original-filter-fn))
+ (set-process-filter process #'comint-redirect-filter))
+ (process-send-string process input-to-send)
+ (accept-process-output
+ process
+ python-shell-completion-native-output-timeout)
+ ;; XXX: can't use `python-shell-accept-process-output'
+ ;; here because there are no guarantees on how output
+ ;; ends. The workaround here is to call
+ ;; `accept-process-output' until we don't find anything
+ ;; else to accept.
+ (while (accept-process-output
+ process
+ python-shell-completion-native-output-timeout))
+ (cl-remove-duplicates
+ (split-string
+ (buffer-substring-no-properties
+ (point-min) (point-max))
+ separators t))))
+ (set-process-filter process original-filter-fn))))))
(defun python-shell-completion-get-completions (process import input)
"Do completion at point using PROCESS for IMPORT or INPUT.
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* ((last-prompt-end (cdr (python-util-comint-last-prompt)))
+ (let* ((line-start (if (derived-mode-p 'inferior-python-mode)
+ ;; Working on a shell buffer: use prompt end.
+ (cdr (python-util-comint-last-prompt))
+ (line-beginning-position)))
(import-statement
(when (string-match-p
(rx (* space) word-start (or "from" "import") word-end space)
- (buffer-substring-no-properties last-prompt-end (point)))
- (buffer-substring-no-properties last-prompt-end (point))))
+ (buffer-substring-no-properties line-start (point)))
+ (buffer-substring-no-properties line-start (point))))
(start
(save-excursion
(if (not (re-search-backward
(python-rx
(or whitespace open-paren close-paren string-delimiter))
- last-prompt-end
+ line-start
t 1))
- last-prompt-end
+ line-start
(forward-char (length (match-string-no-properties 0)))
(point))))
(end (point))
:type 'string
:group 'python)
-(defvar-local python-check-custom-command nil
+(defvar python-check-custom-command nil
"Internal use.")
+;; XXX: Avoid `defvar-local' for compat with Emacs<24.3
+(make-variable-buffer-local 'python-check-custom-command)
(defun python-check (command)
"Check a Python file (default current buffer's file).
:type 'string
:group 'python)
+(defun python-eldoc--get-symbol-at-point ()
+ "Get the current symbol for eldoc.
+Returns the current symbol handling point within arguments."
+ (save-excursion
+ (let ((start (python-syntax-context 'paren)))
+ (when start
+ (goto-char start))
+ (when (or start
+ (eobp)
+ (memq (char-syntax (char-after)) '(?\ ?-)))
+ ;; Try to adjust to closest symbol if not in one.
+ (python-util-forward-comment -1)))
+ (python-info-current-symbol t)))
+
(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'
+If not FORCE-INPUT is passed then what `python-eldoc--get-symbol-at-point'
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))))
(when process
(let ((input (or force-input
- (python-info-current-symbol t))))
+ (python-eldoc--get-symbol-at-point))))
(and input
;; Prevent resizing the echo area when iPython is
;; enabled. Bug#18794.
"Get help on SYMBOL using `help'.
Interactively, prompt for symbol."
(interactive
- (let ((symbol (python-info-current-symbol t))
+ (let ((symbol (python-eldoc--get-symbol-at-point))
(enable-recursive-minibuffers t))
(list (read-string (if symbol
(format "Describe symbol (default %s): " symbol)
nil nil symbol))))
(message (python-eldoc--get-doc-at-point symbol)))
+\f
+;;; Hideshow
+
+(defun python-hideshow-forward-sexp-function (arg)
+ "Python specific `forward-sexp' function for `hs-minor-mode'.
+Argument ARG is ignored."
+ arg ; Shut up, byte compiler.
+ (python-nav-end-of-defun)
+ (unless (python-info-current-line-empty-p)
+ (backward-char)))
+
\f
;;; Imenu
n (1- n)))
(reverse acc))))
-(defun python-util-text-properties-replace-name
- (from to &optional start end)
- "Replace properties named FROM to TO, keeping its value.
-Arguments START and END narrow the buffer region to work on."
- (save-excursion
- (goto-char (or start (point-min)))
- (while (not (eobp))
- (let ((plist (text-properties-at (point)))
- (next-change (or (next-property-change (point) (current-buffer))
- (or end (point-max)))))
- (when (plist-get plist from)
- (let* ((face (plist-get plist from))
- (plist (plist-put plist from nil))
- (plist (plist-put plist to face)))
- (set-text-properties (point) next-change plist (current-buffer))))
- (goto-char next-change)))))
-
(defun python-util-strip-string (string)
"Strip STRING whitespace and newlines from end and beginning."
(replace-regexp-in-string
(current-column))))
(^ '(- (1+ (current-indentation))))))
- (add-function :before-until (local 'eldoc-documentation-function)
- #'python-eldoc-function)
-
- (add-to-list 'hs-special-modes-alist
- `(python-mode "^\\s-*\\(?:def\\|class\\)\\>" nil "#"
- ,(lambda (_arg)
- (python-nav-end-of-defun))
- nil))
+ (if (null eldoc-documentation-function)
+ ;; Emacs<25
+ (set (make-local-variable 'eldoc-documentation-function)
+ #'python-eldoc-function)
+ (add-function :before-until (local 'eldoc-documentation-function)
+ #'python-eldoc-function))
+
+ (add-to-list
+ 'hs-special-modes-alist
+ `(python-mode
+ "\\s-*\\(?:def\\|class\\)\\>"
+ ;; Use the empty string as end regexp so it doesn't default to
+ ;; "\\s)". This way parens at end of defun are properly hidden.
+ ""
+ "#"
+ python-hideshow-forward-sexp-function
+ nil))
(set (make-local-variable 'outline-regexp)
(python-rx (* space) block-start))
(defvar ruby-syntax-before-regexp-re
(concat
;; Special tokens that can't be followed by a division operator.
- "\\(^\\|[[=(,~;<>]"
+ "\\(^\\|[[{|=(,~;<>!]"
;; Distinguish ternary operator tokens.
;; FIXME: They don't really have to be separated with spaces.
"\\|[?:] "
"rescue"
"retry"
"return"
- "then"
+ "self"
"super"
+ "then"
"unless"
"undef"
"until"
"at_exit"
"autoload"
"autoload?"
+ "callcc"
"catch"
"eval"
"exec"
- "fork"
"format"
"lambda"
"load"
"sprintf"
"syscall"
"system"
+ "throw"
+ "trace_var"
"trap"
+ "untrace_var"
"warn"
;; keyword-like private methods on Module
"alias_method"
"__dir__"
"__method__"
"abort"
- "at_exit"
"binding"
"block_given?"
"caller"
"exit"
"exit!"
"fail"
+ "fork"
+ "global_variables"
+ "local_variables"
"private"
"protected"
"public"
"readline"
"readlines"
"sleep"
- "srand"
- "throw")
+ "srand")
'symbols))
(1 font-lock-builtin-face))
;; Here-doc beginnings.
"\\_<\\(?:BEGIN\\|END\\)\\_>\\|^__END__$"
;; Variables.
(,(concat ruby-font-lock-keyword-beg-re
- "\\_<\\(nil\\|self\\|true\\|false\\)\\_>")
- 1 font-lock-variable-name-face)
+ "\\_<\\(nil\\|true\\|false\\)\\_>")
+ 1 font-lock-constant-face)
;; Keywords that evaluate to certain values.
("\\_<__\\(?:LINE\\|ENCODING\\|FILE\\)__\\_>"
(0 font-lock-builtin-face))
- ;; Symbols.
- ("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|@?\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)"
+ ;; Symbols with symbol characters.
+ ("\\(^\\|[^:]\\)\\(:@?\\(?:\\w\\|_\\)+\\)\\([!?=]\\)?"
+ (2 font-lock-constant-face)
+ (3 (unless (and (eq (char-before (match-end 3)) ?=)
+ (eq (char-after (match-end 3)) ?>))
+ ;; bug#18466
+ font-lock-constant-face)
+ nil t))
+ ;; Symbols with special characters.
+ ("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)"
2 font-lock-constant-face)
;; Special globals.
(,(concat "\\$\\(?:[:\"!@;,/\\._><\\$?~=*&`'+0-9]\\|-[0adFiIlpvw]\\|"
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Michael Mauger <michael@mauger.com>
-;; Version: 3.4
+;; Version: 3.5
;; Keywords: comm languages processes
;; URL: http://savannah.gnu.org/projects/emacs/
(defun sql-starts-with-prompt-re ()
"Anchor the prompt expression at the beginning of the output line.
Remove the start of line regexp."
- (replace-regexp-in-string "\\^" "\\\\`" comint-prompt-regexp))
+ (concat "\\`" comint-prompt-regexp))
(defun sql-ends-with-prompt-re ()
"Anchor the prompt expression at the end of the output line.
-Remove the start of line regexp from the prompt expression since
-it may not follow newline characters in the output line."
- (concat (replace-regexp-in-string "\\^" "" sql-prompt-regexp) "\\'"))
+Match a SQL prompt or a password prompt."
+ (concat "\\(?:\\(?:" sql-prompt-regexp "\\)\\|"
+ "\\(?:" comint-password-prompt-regexp "\\)\\)\\'"))
(defun sql-interactive-remove-continuation-prompt (oline)
"Strip out continuation prompts out of the OLINE.
If the filter gets confused, it should reset and stop filtering
to avoid deleting non-prompt output."
- (when comint-prompt-regexp
+ ;; continue gathering lines of text iff
+ ;; + we know what a prompt looks like, and
+ ;; + there is held text, or
+ ;; + there are continuation prompt yet to come, or
+ ;; + not just a prompt string
+ (when (and comint-prompt-regexp
+ (or (> (length (or sql-preoutput-hold "")) 0)
+ (> (or sql-output-newline-count 0) 0)
+ (not (or (string-match sql-prompt-regexp oline)
+ (string-match sql-prompt-cont-regexp oline)))))
+
(save-match-data
(let (prompt-found last-nl)
sql-preoutput-hold ""))
;; Break up output by physical lines if we haven't hit the final prompt
- (unless (and (not (string= oline ""))
- (string-match (sql-ends-with-prompt-re) oline)
- (>= (match-end 0) (length oline)))
- (setq last-nl 0)
- (while (string-match "\n" oline last-nl)
- (setq last-nl (match-end 0)))
- (setq sql-preoutput-hold (concat (substring oline last-nl)
- sql-preoutput-hold)
- oline (substring oline 0 last-nl))))))
- oline)
+ (let ((end-re (sql-ends-with-prompt-re)))
+ (unless (and (not (string= oline ""))
+ (string-match end-re oline)
+ (>= (match-end 0) (length oline)))
+ ;; Find everything upto the last nl
+ (setq last-nl 0)
+ (while (string-match "\n" oline last-nl)
+ (setq last-nl (match-end 0)))
+ ;; Hold after the last nl, return upto last nl
+ (setq sql-preoutput-hold (concat (substring oline last-nl)
+ sql-preoutput-hold)
+ oline (substring oline 0 last-nl)))))))
+ oline)
;;; Sending the region to the SQLi buffer.
;;; Code:
;; This variable will always hold the version number of the mode
-(defconst verilog-mode-version "2014-11-12-aa4b777-vpo"
+(defconst verilog-mode-version "2015-02-20-0d6420b-vpo"
"Version of this Verilog mode.")
(defconst verilog-mode-release-emacs t
"If non-nil, this version of Verilog mode was released with Emacs itself.")
(defvar sigs-temp)
;; These are known to be from other packages and may not be defined
(defvar diff-command nil)
- (defvar vector-skip-list)
;; There are known to be from newer versions of Emacs
(defvar create-lockfiles))
(defvar vl-bits nil "See `verilog-auto-inst'.") ; Prevent compile warning
(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)
+(defun verilog-auto-inst-port (port-st indent-pt moddecls tpl-list tpl-num for-star par-values)
"Print out an instantiation connection for this PORT-ST.
Insert to INDENT-PT, use template TPL-LIST.
@ are instantiation numbers, replaced with TPL-NUM.
(vl-mbits (if (verilog-sig-multidim port-st)
(verilog-sig-multidim-string port-st) ""))
(vl-bits (if (or verilog-auto-inst-vector
- (not (assoc port vector-skip-list))
+ (not (assoc port (verilog-decls-get-signals moddecls)))
(not (equal (verilog-sig-bits port-st)
- (verilog-sig-bits (assoc port vector-skip-list)))))
+ (verilog-sig-bits
+ (assoc port (verilog-decls-get-signals moddecls))))))
(or (verilog-sig-bits port-st) "")
""))
(case-fold-search nil)
(concat "/*" vl-mbits vl-bits "*/")
(concat vl-bits))
tpl-net (concat port
- (if vl-modport (concat "." vl-modport) "")
+ (if (and vl-modport
+ ;; .modport cannot be added if attachment is
+ ;; already declared as modport, VCS croaks
+ (let ((sig (assoc port (verilog-decls-get-interfaces moddecls))))
+ (not (and sig (verilog-sig-modport sig)))))
+ (concat "." vl-modport) "")
dflt-bits))
;; Find template
(cond (tpl-ass ; Template of exact port name
;;(x "incom[@\"(+ (* 8 @) 7)\":@\"(* 8 @)\"]")
;;(x ".out (outgo[@\"(concat (+ (* 8 @) 7) \\\":\\\" ( * 8 @))\"]));")
-(defun verilog-auto-inst-port-list (sig-list indent-pt tpl-list tpl-num for-star par-values)
+(defun verilog-auto-inst-port-list (sig-list indent-pt moddecls tpl-list tpl-num for-star par-values)
"For `verilog-auto-inst' print a list of ports using `verilog-auto-inst-port'."
(when verilog-auto-inst-sort
(setq sig-list (sort (copy-alist sig-list) `verilog-signals-sort-compare)))
(mapc (lambda (port)
- (verilog-auto-inst-port port indent-pt
+ (verilog-auto-inst-port port indent-pt moddecls
tpl-list tpl-num for-star par-values))
sig-list))
(+ 16 (* 8 (/ (+ indent-pt 7) 8)))))
(modi (verilog-modi-current))
(moddecls (verilog-modi-get-decls modi))
- (vector-skip-list (unless verilog-auto-inst-vector
- (verilog-decls-get-signals moddecls)))
submod submodi submoddecls
inst skip-pins tpl-list tpl-num did-first par-values)
(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")
- (verilog-auto-inst-port-list sig-list indent-pt
+ (verilog-auto-inst-port-list sig-list indent-pt moddecls
tpl-list tpl-num for-star par-values)))
(let ((sig-list (verilog-signals-not-in
(verilog-decls-get-interfaces submoddecls)
(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 "// Interfaces\n")
- (verilog-auto-inst-port-list sig-list indent-pt
+ (verilog-auto-inst-port-list sig-list indent-pt moddecls
tpl-list tpl-num for-star par-values)))
(let ((sig-list (verilog-signals-not-in
(verilog-decls-get-outputs submoddecls)
(when sig-list
(when (not did-first) (verilog-auto-inst-first) (setq did-first t))
(verilog-insert-indent "// Outputs\n")
- (verilog-auto-inst-port-list sig-list indent-pt
+ (verilog-auto-inst-port-list sig-list indent-pt moddecls
tpl-list tpl-num for-star par-values)))
(let ((sig-list (verilog-signals-not-in
(verilog-decls-get-inouts submoddecls)
(when sig-list
(when (not did-first) (verilog-auto-inst-first) (setq did-first t))
(verilog-insert-indent "// Inouts\n")
- (verilog-auto-inst-port-list sig-list indent-pt
+ (verilog-auto-inst-port-list sig-list indent-pt moddecls
tpl-list tpl-num for-star par-values)))
(let ((sig-list (verilog-signals-not-in
(verilog-decls-get-inputs submoddecls)
(when sig-list
(when (not did-first) (verilog-auto-inst-first) (setq did-first t))
(verilog-insert-indent "// Inputs\n")
- (verilog-auto-inst-port-list sig-list indent-pt
+ (verilog-auto-inst-port-list sig-list indent-pt moddecls
tpl-list tpl-num for-star par-values)))
;; Kill extra semi
(save-excursion
(+ 16 (* 8 (/ (+ indent-pt 7) 8)))))
(modi (verilog-modi-current))
(moddecls (verilog-modi-get-decls modi))
- (vector-skip-list (unless verilog-auto-inst-vector
- (verilog-decls-get-signals moddecls)))
submod submodi submoddecls
inst skip-pins tpl-list tpl-num did-first)
;; Find module name that is instantiated
(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 "// Parameters\n")
- (verilog-auto-inst-port-list sig-list indent-pt
+ (verilog-auto-inst-port-list sig-list indent-pt moddecls
tpl-list tpl-num nil nil)))
;; Kill extra semi
(save-excursion
;; 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.36.1"
+(defconst vhdl-version "3.37.1"
"VHDL Mode version number.")
-(defconst vhdl-time-stamp "2014-11-27"
+(defconst vhdl-time-stamp "2015-01-15"
"VHDL Mode time stamp for last update.")
;; This file is part of GNU Emacs.
;; - Block commenting
;; - Code fixing/alignment/beautification
;; - PostScript printing
-;; - VHDL'87/'93 and VHDL-AMS supported
+;; - VHDL'87/'93/'02/'08 and VHDL-AMS supported
;; - Comprehensive menu
;; - Fully customizable
;; - Works under GNU Emacs (recommended) and XEmacs
Basic standard:
VHDL'87 : IEEE Std 1076-1987
VHDL'93/02 : IEEE Std 1076-1993/2002
+ VHDL'08 : IEEE Std 1076-2008
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/02" 93))
+ (const :tag "VHDL'93/02" 93)
+ (const :tag "VHDL'08" 08))
(set :tag "Additional standards" :indent 2
(const :tag "VHDL-AMS" ams)
(const :tag "Math packages" math)))
:type 'boolean
:group 'vhdl-template)
+(defcustom vhdl-sensitivity-list-all t
+ "Non-nil means use 'all' keyword in sensitivity list."
+ :version "25.1"
+ :type 'boolean
+ :group 'vhdl-template)
+
(defcustom vhdl-zero-string "'0'"
"String to use for a logic zero."
:type 'string
'vhdl-words-init 'vhdl-font-lock-init))
:group 'vhdl-highlight)
-(defcustom vhdl-directive-keywords '("pragma" "synopsys")
+(defcustom vhdl-directive-keywords '("psl" "pragma" "synopsys")
"List of compiler directive keywords recognized for highlighting.
NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
(package . 0)
(architecture . 0)
(package-body . 0)
+ (context . 0)
+ (directive . 0)
)
"Default settings for offsets of syntactic elements.
Do not change this constant! See the variable `vhdl-offsets-alist' for
configuration -- inside a configuration declaration
package -- inside a package declaration
architecture -- inside an architecture body
- package-body -- inside a package body")
+ package-body -- inside a package body
+ context -- inside a context declaration")
(defvar vhdl-comment-only-line-offset 0
"Extra offset for line which contains only the start of a comment.
(define-key vhdl-template-map "Cd" 'vhdl-template-configuration-decl)
(define-key vhdl-template-map "Cs" 'vhdl-template-configuration-spec)
(define-key vhdl-template-map "co" 'vhdl-template-constant)
+ (define-key vhdl-template-map "ct" 'vhdl-template-context)
(define-key vhdl-template-map "di" 'vhdl-template-disconnect)
(define-key vhdl-template-map "el" 'vhdl-template-else)
(define-key vhdl-template-map "ei" 'vhdl-template-elsif)
(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)
;; define underscore
(modify-syntax-entry ?\_ (if vhdl-underscore-is-part-of-word "w" "_") st)
- ;; a single hyphen is punctuation, but a double hyphen starts a comment
- (modify-syntax-entry ?\- ". 12" st)
- ;; and \n and \^M end a comment
- (modify-syntax-entry ?\n ">" st)
- (modify-syntax-entry ?\^M ">" st)
+ ;; single-line comments
+ (modify-syntax-entry ?\- ". 12b" st)
+ ;; multi-line comments
+ (modify-syntax-entry ?\/ ". 14b" st)
+ (modify-syntax-entry ?* ". 23" st)
+ (modify-syntax-entry ?\n "> b" st)
+ (modify-syntax-entry ?\^M "> b" st)
;; define parentheses to match
(modify-syntax-entry ?\( "()" st)
(modify-syntax-entry ?\) ")(" st)
("configuration" . vhdl-template-configuration-hook)
("cons" . vhdl-template-constant-hook)
("constant" . vhdl-template-constant-hook)
+ ("context" . vhdl-template-context-hook)
("disconnect" . vhdl-template-disconnect-hook)
("downto" . vhdl-template-default-hook)
("else" . vhdl-template-else-hook)
("configuration declaration" vhdl-template-configuration-decl)
("configuration specification" vhdl-template-configuration-spec)
("constant declaration" vhdl-template-constant)
+ ("context declaration" vhdl-template-context)
("disconnection specification" vhdl-template-disconnect)
("entity declaration" vhdl-template-entity)
("exit statement" vhdl-template-exit)
["Configuration (Decl)" vhdl-template-configuration-decl t]
["Configuration (Spec)" vhdl-template-configuration-spec t]
["Constant" vhdl-template-constant t]
+ ["Context" vhdl-template-context t]
["Disconnect" vhdl-template-disconnect t]
["Else" vhdl-template-else t]
["Elsif" vhdl-template-elsif t]
(list '93 (cadr vhdl-standard)))
(vhdl-activate-customizations))
:style radio :selected (eq '93 (car vhdl-standard))]
+ ["VHDL'08"
+ (progn (customize-set-variable 'vhdl-standard
+ (list '08 (cadr vhdl-standard)))
+ (vhdl-activate-customizations))
+ :style radio :selected (eq '08 (car vhdl-standard))]
"--"
["VHDL-AMS"
(progn (customize-set-variable
(customize-set-variable 'vhdl-conditions-in-parenthesis
(not vhdl-conditions-in-parenthesis))
:style toggle :selected vhdl-conditions-in-parenthesis]
+ ["Sensitivity List uses 'all'"
+ (customize-set-variable 'vhdl-sensitivity-list-all
+ (not vhdl-sensitivity-list-all))
+ :style toggle :selected vhdl-sensitivity-list-all]
["Zero String..." (customize-option 'vhdl-zero-string) t]
["One String..." (customize-option 'vhdl-one-string) t]
("File Header"
("Entity"
"^\\s-*\\(entity\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
2)
+ ("Context"
+ "^\\s-*\\(context\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
+ 2)
)
"Imenu generic expression for VHDL Mode. See `imenu-generic-expression'.")
VHDL STANDARDS:
The VHDL standards to be used are specified in option `vhdl-standard'.
- Available standards are: VHDL'87/'93(02), VHDL-AMS, and Math Packages.
+ Available standards are: VHDL'87/'93(02)/'08, VHDL-AMS, and Math Packages.
KEYWORD CASE:
)
"List of VHDL'02 keywords.")
+(defconst vhdl-08-keywords
+ '(
+ "context" "force" "property" "release" "sequence"
+ )
+ "List of VHDL'08 keywords.")
+
(defconst vhdl-ams-keywords
'(
"across" "break" "limit" "nature" "noise" "procedural" "quantity"
)
"List of VHDL'02 standardized types.")
+(defconst vhdl-08-types
+ '(
+ "boolean_vector" "integer_vector" "real_vector" "time_vector"
+ )
+ "List of VHDL'08 standardized types.")
+
(defconst vhdl-ams-types
;; standards: IEEE Std 1076.1-2007, IEEE Std 1076.1.1-2004
'(
)
"List of VHDL'02 standardized attributes.")
+(defconst vhdl-08-attributes
+ '(
+ "instance_name" "path_name"
+ )
+ "List of VHDL'08 standardized attributes.")
+
(defconst vhdl-ams-attributes
'(
"across" "through"
)
"List of VHDL'02 standardized functions.")
+(defconst vhdl-08-functions
+ '(
+ "finish" "flush" "justify" "maximum" "minimum"
+ "resolution_limit" "rising_edge" "stop" "swrite"
+ "tee" "to_binarystring" "to_bstring" "to_hexstring" "to_hstring"
+ "to_octalstring" "to_ostring" "to_string"
+ )
+ "List of VHDL'08 standardized functions.")
+
(defconst vhdl-ams-functions
'(
;; package `standard'
)
"List of VHDL'02 standardized packages and libraries.")
+(defconst vhdl-08-packages
+ '(
+ "env" "numeric_std_signed" "numeric_std_unsigned"
+ "ieee_bit_context" "ieee_std_context" ;; contexts
+ )
+ "List of VHDL'08 standardized packages and libraries.")
+
(defconst vhdl-ams-packages
'(
"fundamental_constants" "material_constants" "energy_systems"
)
"List of Math Packages standardized packages and libraries.")
+(defconst vhdl-08-directives
+ '(
+ "author" "author_info" "begin" "begin_protected" "comment"
+ "data_block" "data_keyname" "data_keyowner" "data_method"
+ "decrypt_license" "digest_block" "digest_key_method" "digest_keyname"
+ "digest_keyowner" "digest_method"
+ "encoding" "encrypt_agent" "encrypt_agent_info" "end" "end_protected"
+ "key_block" "key_keyname" "key_keyowner" "key_method"
+ "runtime_license" "viewport"
+ )
+ "List of VHDL'08 standardized tool directives.")
+
(defvar vhdl-keywords nil
"List of VHDL keywords.")
(defvar vhdl-packages nil
"List of VHDL standardized packages and libraries.")
+(defvar vhdl-directives nil
+ "List of VHDL standardized packages and libraries.")
+
(defvar vhdl-reserved-words nil
"List of additional reserved words.")
(vhdl-upcase-list
(and vhdl-highlight-case-sensitive vhdl-upper-case-keywords)
(append vhdl-02-keywords
+ (when (vhdl-standard-p '08) vhdl-08-keywords)
(when (vhdl-standard-p 'ams) vhdl-ams-keywords))))
(setq vhdl-types
(vhdl-upcase-list
(and vhdl-highlight-case-sensitive vhdl-upper-case-types)
(append vhdl-02-types
+ (when (vhdl-standard-p '08) vhdl-08-types)
(when (vhdl-standard-p 'ams) vhdl-ams-types)
(when (vhdl-standard-p 'math) vhdl-math-types))))
(setq vhdl-attributes
(vhdl-upcase-list
(and vhdl-highlight-case-sensitive vhdl-upper-case-attributes)
(append vhdl-02-attributes
+ (when (vhdl-standard-p '08) vhdl-08-attributes)
(when (vhdl-standard-p 'ams) vhdl-ams-attributes))))
(setq vhdl-enum-values
(vhdl-upcase-list
'(""))))
(setq vhdl-functions
(append vhdl-02-functions
+ (when (vhdl-standard-p '08) vhdl-08-functions)
(when (vhdl-standard-p 'ams) vhdl-ams-functions)
(when (vhdl-standard-p 'math) vhdl-math-functions)))
(setq vhdl-packages
(append vhdl-02-packages
+ (when (vhdl-standard-p '08) vhdl-08-packages)
(when (vhdl-standard-p 'ams) vhdl-ams-packages)
(when (vhdl-standard-p 'math) vhdl-math-packages)))
+ (setq vhdl-directives
+ (append (when (vhdl-standard-p '08) vhdl-08-directives)))
(setq vhdl-reserved-words
(append (when vhdl-highlight-forbidden-words vhdl-forbidden-words)
(when vhdl-highlight-verilog-keywords vhdl-verilog-keywords)
(list vhdl-upper-case-enum-values) vhdl-enum-values
(list vhdl-upper-case-constants) vhdl-constants
(list nil) vhdl-functions
- (list nil) vhdl-packages)))
+ (list nil) vhdl-packages
+ (list nil) vhdl-directives)))
;; initialize reserved words for VHDL Mode
(vhdl-words-init)
;; Syntactic support functions:
-(defun vhdl-in-comment-p ()
- "Check if point is in a comment."
- (eq (vhdl-in-literal) 'comment))
+(defun vhdl-in-comment-p (&optional pos)
+ "Check if point is in a comment (include multi-line comments)."
+ (let ((parse (lambda (p)
+ (let ((c (char-after p)))
+ (or (and c (eq (char-syntax c) ?<))
+ (nth 4 (parse-partial-sexp
+ (save-excursion
+ (beginning-of-defun)
+ (point)) p)))))))
+ (save-excursion
+ (goto-char (or pos (point)))
+ (or (funcall parse (point))
+ ;; `parse-partial-sexp's notion of comments doesn't span lines
+ (progn
+ (back-to-indentation)
+ (unless (eolp)
+ (forward-char)
+ (funcall parse (point))))))))
(defun vhdl-in-string-p ()
"Check if point is in a string."
((nth 3 state) 'string)
((nth 4 state) 'comment)
((vhdl-beginning-of-macro) 'pound)
+ ((vhdl-beginning-of-directive) 'directive)
+ ;; for multi-line comments
+ ((and (vhdl-standard-p '08) (vhdl-in-comment-p)) 'comment)
(t nil)))))
(defun vhdl-in-extended-identifier-p ()
(goto-char lim )
(while (< (point) here)
(setq match
- (and (re-search-forward "--\\|[\"']"
+ (and (re-search-forward "--\\|[\"']\\|`"
here 'move)
(buffer-substring (match-beginning 0) (match-end 0))))
(setq state
;; looking at the opening of a VHDL style comment
((string= "--" match)
(if (<= here (progn (end-of-line) (point))) 'comment))
+ ;; looking at a directive
+ ((string= "`" match)
+ (if (<= here (progn (end-of-line) (point))) 'directive))
;; looking at the opening of a double quote string
((string= "\"" match)
(if (not (save-restriction
(setq here (point))
(vhdl-forward-comment hugenum)
;; skip preprocessor directives
- (when (and (eq (char-after) ?#)
+ (when (and (or (eq (char-after) ?#) (eq (char-after) ?`))
(= (vhdl-point 'boi) (point)))
(while (and (eq (char-before (vhdl-point 'eol)) ?\\)
(= (forward-line 1) 0)))
(goto-char here)
nil)))
+(defun vhdl-beginning-of-directive (&optional lim)
+ "Go to the beginning of a directive (nicked from `cc-engine')."
+ (let ((here (point)))
+ (beginning-of-line)
+ (while (eq (char-before (1- (point))) ?\\)
+ (forward-line -1))
+ (back-to-indentation)
+ (if (and (<= (point) here)
+ (eq (char-after) ?`))
+ t
+ (goto-char here)
+ nil)))
+
(defun vhdl-backward-syntactic-ws (&optional lim)
"Backward skip over syntactic whitespace."
(let* ((here (point-min))
;; Core syntactic evaluation functions:
(defconst vhdl-libunit-re
- "\\b\\(architecture\\|configuration\\|entity\\|package\\)\\b[^_]")
+ "\\b\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\b[^_]")
(defun vhdl-libunit-p ()
(and
))
(defconst vhdl-defun-re
- "\\b\\(architecture\\|block\\|configuration\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]")
+ "\\b\\(architecture\\|block\\|configuration\\|context\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]")
(defun vhdl-defun-p ()
(save-excursion
(save-excursion
(backward-sexp)
(not (looking-at "end\\s-+\\w")))
- ;; "architecture", "configuration", "entity",
+ ;; "architecture", "configuration", "context", "entity",
;; "package", "procedure", "function":
t)))
(if (looking-at "block\\|process\\|procedural")
;; "block", "process". "procedural:
(buffer-substring (match-beginning 0) (match-end 0))
- ;; "architecture", "configuration", "entity", "package",
+ ;; "architecture", "configuration", "context", "entity", "package",
;; "procedure", "function":
"is"))))
the middle of an identifier that just happens to contain a \"begin\"
keyword."
(cond
- ;; "[architecture|case|configuration|entity|package|
+ ;; "[architecture|case|configuration|context|entity|package|
;; procedure|function] ... is":
((and (looking-at "i")
(save-excursion
(let (foundp)
(while (and (not foundp)
(re-search-backward
- ";\\|\\b\\(architecture\\|case\\|configuration\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]"
+ ";\\|\\b\\(architecture\\|case\\|configuration\\|context\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]"
lim 'move))
(if (or (= (preceding-char) ?_)
(vhdl-in-literal))
(vector "for" (vhdl-first-word pos) nil nil))
;; "end [id]":
(t
- (vector "begin\\|architecture\\|configuration\\|entity\\|package\\|procedure\\|function"
+ (vector "begin\\|architecture\\|configuration\\|context\\|entity\\|package\\|procedure\\|function"
(vhdl-first-word pos)
;; return an alist of (statement . keyword) mappings
'(
("architecture" . "is")
;; "configuration ... is ... end [id]":
("configuration" . "is")
+ ;; "context ... is ... end [id]":
+ ("context" . "is")
;; "entity ... is ... end [id]":
("entity" . "is")
;; "package ... is ... end [id]":
(cond
((looking-at "e") 'entity)
((looking-at "a") 'architecture)
- ((looking-at "c") 'configuration)
+ ((looking-at "conf") 'configuration)
+ ((looking-at "cont") 'context)
((looking-at "p")
(save-excursion
(goto-char bod)
(goto-char (1+ containing-sexp))
(skip-chars-forward " \t")
(not (eolp))
- (not (looking-at "--")))
+ (not (looking-at "--\\|`")))
(save-excursion
(vhdl-beginning-of-statement-1 containing-sexp)
(skip-chars-backward " \t(")
;; now we need to look at any modifiers
(goto-char indent-point)
(skip-chars-forward " \t")
- (if (looking-at "--")
+ (if (or (looking-at "--") (looking-at "/\\*"))
(vhdl-add-syntax 'comment))
+ (if (looking-at "`")
+ (vhdl-add-syntax 'directive))
(if (eq literal 'pound)
(vhdl-add-syntax 'cpp-macro))
;; return the syntax
(vhdl-comment-indent)
;; otherwise, indent as specified by vhdl-comment-only-line-offset
(if (not (bolp))
+ ;; inside multi-line comment
+ (if (looking-at "\\*")
+ 1
+ ;; otherwise
(or (car-safe vhdl-comment-only-line-offset)
- vhdl-comment-only-line-offset)
+ vhdl-comment-only-line-offset))
(or (cdr-safe vhdl-comment-only-line-offset)
(car-safe vhdl-comment-only-line-offset)
-1000 ;jam it against the left side
(mapc
(function
(lambda (elt)
- (if (memq (car elt) '(entity configuration package
+ (if (memq (car elt) '(entity configuration context package
package-body architecture))
nil
(setq expurgated (append expurgated (list elt))))))
(vhdl-prepare-search-2
(save-excursion
;; search for declarative part
- (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|end\\|entity\\|package\\)\\>" nil t)
+ (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|context\\|end\\|entity\\|package\\)\\>" nil t)
(not (member (upcase (match-string 1)) '("BEGIN" "END"))))
(setq beg (point))
(re-search-forward "^\\(begin\\|end\\)\\>" nil t)
(insert ";")
(vhdl-comment-insert-inline))))))
+(defun vhdl-template-context ()
+ "Insert a context declaration."
+ (interactive)
+ (let ((margin (current-indentation))
+ (start (point))
+ entity-exists string name position)
+ (vhdl-insert-keyword "CONTEXT ")
+ (when (setq name (vhdl-template-field "name" nil t start (point)))
+ (vhdl-insert-keyword " IS\n")
+ (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
+ (indent-to (+ margin vhdl-basic-offset))
+ (setq position (point))
+ (insert "\n")
+ (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
+ (indent-to margin)
+ (vhdl-insert-keyword "END ")
+ (unless (vhdl-standard-p '87)
+ (vhdl-insert-keyword "CONTEXT "))
+ (insert name ";")
+ (goto-char position))))
+
(defun vhdl-template-default ()
"Insert nothing."
(interactive)
(forward-char 1))
(insert "(")
(if (not seq)
- (unless (setq input-signals
- (vhdl-template-field "[sensitivity list]" ")" t))
+ (unless (or (and (vhdl-standard-p '08) vhdl-sensitivity-list-all
+ (progn (insert "all)") (setq input-signals "all")))
+ (setq input-signals
+ (vhdl-template-field "[sensitivity list]" ")" t)))
(setq input-signals "")
(delete-char -2))
(setq clock (or (and (not (equal "" vhdl-clock-name))
(while (search-forward "<standard>" end t)
(replace-match
(concat "VHDL" (cond ((vhdl-standard-p '87) "'87")
- ((vhdl-standard-p '93) "'93/02"))
+ ((vhdl-standard-p '93) "'93/02")
+ ((vhdl-standard-p '08) "'08"))
(when (vhdl-standard-p 'ams) ", VHDL-AMS")
(when (vhdl-standard-p 'math) ", Math Packages")) t t))
(goto-char beg)
(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))
+ (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|context\\|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
(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))
+ (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|context\\|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
(vhdl-hooked-abbrev 'vhdl-template-configuration))
(defun vhdl-template-constant-hook ()
(vhdl-hooked-abbrev 'vhdl-template-constant))
+(defun vhdl-template-context-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-context))
(defun vhdl-template-disconnect-hook ()
(vhdl-hooked-abbrev 'vhdl-template-disconnect))
(defun vhdl-template-display-comment-hook ()
(list
(concat
"^\\s-*\\("
- "architecture\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|"
+ "architecture\\|configuration\\|context\\|entity\\|package"
+ "\\(\\s-+body\\)?\\|"
"\\(\\(impure\\|pure\\)\\s-+\\)?function\\|procedure\\|component"
"\\)\\s-+\\(\\w+\\)")
5 'font-lock-function-name-face)
(list
(concat
"^\\s-*end\\s-+\\(\\("
- "architecture\\|block\\|case\\|component\\|configuration\\|entity\\|"
- "for\\|function\\|generate\\|if\\|loop\\|package\\(\\s-+body\\)?\\|"
- "procedure\\|\\(postponed\\s-+\\)?process\\|"
+ "architecture\\|block\\|case\\|component\\|configuration\\|context\\|"
+ "entity\\|for\\|function\\|generate\\|if\\|loop\\|package"
+ "\\(\\s-+body\\)?\\|procedure\\|\\(postponed\\s-+\\)?process\\|"
(when (vhdl-standard-p 'ams) "procedural\\|")
"units"
"\\)\\s-+\\)?\\(\\w*\\)")
;; highlight names in use clauses
(list
(concat
- "\\<use\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?"
+ "\\<\\(context\\|use\\)\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?"
"\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\((\\(\\w+\\))\\)?")
- '(3 font-lock-function-name-face) '(5 font-lock-function-name-face nil t)
- '(7 font-lock-function-name-face nil t))
+ '(4 font-lock-function-name-face) '(6 font-lock-function-name-face nil t)
+ '(8 font-lock-function-name-face nil t))
;; highlight attribute name in attribute declarations/specifications
(list
'(vhdl-font-lock-match-item
(progn (goto-char (match-end 1)) (match-beginning 2))
nil (1 font-lock-variable-name-face)))
+
+ ;; highlight tool directives
+ (list
+ (concat
+ "^\\s-*\\(`\\w+\\)")
+ 1 'font-lock-preprocessor-face)
)
"For consideration as a value of `vhdl-font-lock-keywords'.
This does context sensitive highlighting of names and labels.")
"Return position of end of current unit."
(let ((pos (point)))
(save-excursion
- (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil 1)
+ (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil 1)
(save-excursion
(goto-char (match-beginning 0))
(vhdl-backward-syntactic-ws)
"Scan the context clause that precedes a design unit."
(let (lib-alist)
(save-excursion
- (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil t)
+ (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|context\\|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\r\f]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+")
'vhdl-argument-list-indent
'vhdl-association-list-with-formals
'vhdl-conditions-in-parenthesis
+ 'vhdl-sensitivity-list-all
'vhdl-zero-string
'vhdl-one-string
'vhdl-file-header
(defconst vhdl-doc-release-notes nil
"\
+Release Notes for VHDL Mode 3.37
+================================
+
+- Added support for VHDL'08:
+ - New keywords, types, functions, attributes, operators, packages
+ - Context declaration
+ - Block comments
+ - Directives
+ - 'all' keyword in sensitivity list
+
+
Release Notes for VHDL Mode 3.34
================================
Reserved words in VHDL
----------------------
+VHDL'08 (IEEE Std 1076-2008):
+ `vhdl-08-keywords' : keywords
+ `vhdl-08-types' : standardized types
+ `vhdl-08-attributes' : standardized attributes
+ `vhdl-08-functions' : standardized functions
+ `vhdl-08-packages' : standardized packages and libraries
+
VHDL'93/02 (IEEE Std 1076-1993/2002):
`vhdl-02-keywords' : keywords
`vhdl-02-types' : standardized types
;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)
+\f
+;;; Helper functions
+
+(defvar xref-etags-mode--saved nil)
+
+(define-minor-mode xref-etags-mode
+ "Minor mode to make xref use etags again.
+
+Certain major modes install their own mechanisms for listing
+identifiers and navigation. Turn this on to undo those settings
+and just use etags."
+ :lighter ""
+ (if xref-etags-mode
+ (progn
+ (setq xref-etags-mode--saved
+ (cons xref-find-function
+ xref-identifier-completion-table-function))
+ (kill-local-variable 'xref-find-function)
+ (kill-local-variable 'xref-identifier-completion-table-function))
+ (setq-local xref-find-function (car xref-etags-mode--saved))
+ (setq-local xref-identifier-completion-table-function
+ (cdr xref-etags-mode--saved))))
+
\f
(provide 'xref)
(add-hook 'deactivate-mark-hook
(lambda () (rectangle-mark-mode -1)))
(unless (region-active-p)
- (push-mark)
- (activate-mark)
+ (push-mark (point) t t)
(message "Mark set (rectangle mode)"))))
(defun rectangle-exchange-point-and-mark (&optional arg)
(goto-char (cadr val)))
((markerp val)
(or (marker-buffer val)
- (error "That register's buffer no longer exists"))
+ (user-error "That register's buffer no longer exists"))
(switch-to-buffer (marker-buffer val))
+ (unless (or (= (point) (marker-position val))
+ (eq last-command 'jump-to-register))
+ (push-mark))
(goto-char val))
((and (consp val) (eq (car val) 'file))
(find-file (cdr val)))
((and (consp val) (eq (car val) 'file-query))
(or (find-buffer-visiting (nth 1 val))
(y-or-n-p (format "Visit file %s again? " (nth 1 val)))
- (error "Register access aborted"))
+ (user-error "Register access aborted"))
(find-file (nth 1 val))
(goto-char (nth 2 val)))
(t
- (error "Register doesn't contain a buffer position or configuration")))))
+ (user-error "Register doesn't contain a buffer position or configuration")))))
(defun register-swap-out ()
"Turn markers into file-query references when a buffer is killed."
(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")))))
+ (t (user-error "Register does not contain a number or text")))))
(defun view-register (register)
"Display what is contained in register named REGISTER.
((and (markerp val) (marker-position val))
(princ (marker-position val) (current-buffer)))
(t
- (error "Register does not contain text"))))
+ (user-error "Register does not contain text"))))
(if (not arg) (exchange-point-and-mark)))
(defun copy-to-register (register start end &optional delete-flag region)
(set-register
register (cond ((not reg) text)
((stringp reg) (concat reg separator text))
- (t (error "Register does not contain text")))))
+ (t (user-error "Register does not contain text")))))
(setq deactivate-mark t)
(cond (delete-flag
(delete-region start end))
(set-register
register (cond ((not reg) text)
((stringp reg) (concat text separator reg))
- (t (error "Register does not contain text")))))
+ (t (user-error "Register does not contain text")))))
(setq deactivate-mark t)
(cond (delete-flag
(delete-region start end))
(ido-ignore-item-temp-list bufs))
(while (not (string-equal
(setq buf (read-buffer
- (if (eq read-buffer-function 'ido-read-buffer)
+ (if (eq read-buffer-function #'ido-read-buffer)
"Next buffer to search (C-j to end): "
"Next buffer to search (RET to end): ")
nil t))
;; frame. If running a GUI server, force the frame
;; type to GUI. (Cygwin is perfectly happy with
;; multi-tty support, so don't override the user's
- ;; choice there.)
+ ;; choice there.) In daemon mode on Windows, we can't
+ ;; make tty frames, so force the frame type to GUI
+ ;; there too.
(when (and (eq system-type 'windows-nt)
- (eq window-system 'w32))
+ (or (daemonp)
+ (eq window-system 'w32)))
(push "-window-system" args-left)))
;; -position LINE[:COLUMN]: Set point to the given
terminal-frame)))))
(setq tty-name nil tty-type nil)
(if display (server-select-display display)))
- ((eq tty-name 'window-system)
+ ((or (and (eq system-type 'windows-nt)
+ (daemonp)
+ (setq display "w32"))
+ (eq tty-name 'window-system))
(server-create-window-system-frame display nowait proc
parent-id
frame-parameters))
(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)))
+ (if (> nabs (if (listp (symbol-value minibuffer-history-variable))
+ (length (symbol-value minibuffer-history-variable))
+ 0))
(user-error "Beginning of history; no preceding item"))
(unless (memq last-command '(next-history-element
previous-history-element))
next element of the minibuffer history in the minibuffer."
(interactive "^p")
(or arg (setq arg 1))
- (let ((old-point (point)))
+ (let* ((old-point (point))
+ ;; Remember the original goal column of possibly multi-line input
+ ;; excluding the length of the prompt on the first line.
+ (prompt-end (minibuffer-prompt-end))
+ (old-column (unless (and (eolp) (> (point) prompt-end))
+ (if (= (line-number-at-pos) 1)
+ (max (- (current-column) (1- prompt-end)) 0)
+ (current-column)))))
(condition-case nil
(with-no-warnings
(next-line arg))
;; Restore old position since `line-move-visual' moves point to
;; the end of the line when it fails to go to the next line.
(goto-char old-point)
- (next-history-element arg)))))
+ (next-history-element arg)
+ ;; Restore the original goal column on the last line
+ ;; of possibly multi-line input.
+ (goto-char (point-max))
+ (when old-column
+ (if (= (line-number-at-pos) 1)
+ (move-to-column (+ old-column (1- (minibuffer-prompt-end))))
+ (move-to-column old-column)))))))
(defun previous-line-or-history-element (&optional arg)
"Move cursor vertically up ARG lines, or to the previous history element.
previous element of the minibuffer history in the minibuffer."
(interactive "^p")
(or arg (setq arg 1))
- (let ((old-point (point)))
+ (let* ((old-point (point))
+ ;; Remember the original goal column of possibly multi-line input
+ ;; excluding the length of the prompt on the first line.
+ (prompt-end (minibuffer-prompt-end))
+ (old-column (unless (and (eolp) (> (point) prompt-end))
+ (if (= (line-number-at-pos) 1)
+ (max (- (current-column) (1- prompt-end)) 0)
+ (current-column)))))
(condition-case nil
(with-no-warnings
(previous-line arg))
;; Restore old position since `line-move-visual' moves point to
;; the beginning of the line when it fails to go to the previous line.
(goto-char old-point)
- (previous-history-element arg)))))
+ (previous-history-element arg)
+ ;; Restore the original goal column on the first line
+ ;; of possibly multi-line input.
+ (goto-char (minibuffer-prompt-end))
+ (if old-column
+ (if (= (line-number-at-pos) 1)
+ (move-to-column (+ old-column (1- (minibuffer-prompt-end))))
+ (move-to-column old-column))
+ (goto-char (line-end-position)))))))
(defun next-complete-history-element (n)
"Get next history element which completes the minibuffer before the point.
doc string for `insert-for-yank-1', which see."
(interactive "*p")
(if (not (eq last-command 'yank))
- (error "Previous command was not a yank"))
+ (user-error "Previous command was not a yank"))
(setq this-command 'yank)
(unless arg (setq arg 1))
(let ((inhibit-read-only t)
;; the region prior to the last command modifying the buffer.
;; Set the selection to that, or to the current region.
(cond (saved-region-selection
- (gui-set-selection 'PRIMARY saved-region-selection)
+ (if (gui-call gui-selection-owner-p 'PRIMARY)
+ (gui-set-selection 'PRIMARY saved-region-selection))
(setq saved-region-selection nil))
;; If another program has acquired the selection, region
;; deactivation should not clobber it (Bug#11772).
(or use-empty-active-region (> (region-end) (region-beginning)))))
(defun region-active-p ()
- "Return t if Transient Mark mode is enabled and the mark is active.
+ "Return non-nil if Transient Mark mode is enabled and the mark is active.
Some commands act specially on the region when Transient Mark
mode is enabled. Usually, such commands should use
\(Does not affect global mark ring)."
(interactive)
(if (null (mark t))
- (error "No mark set in this buffer")
+ (user-error "No mark set in this buffer")
(if (= (point) (mark t))
(message "Mark popped"))
(goto-char (mark t))
(let ((omark (mark t))
(temp-highlight (eq (car-safe transient-mark-mode) 'only)))
(if (null omark)
- (error "No mark set in this buffer"))
+ (user-error "No mark set in this buffer"))
(set-mark (point))
(goto-char omark)
(cond (temp-highlight
Transient Mark mode if ARG is omitted or nil.
Transient Mark mode is a global minor mode. When enabled, the
-region is highlighted whenever the mark is active. The mark is
-\"deactivated\" by changing the buffer, and after certain other
-operations that set the mark but whose main purpose is something
-else--for example, incremental search, \\[beginning-of-buffer], and \\[end-of-buffer].
+region is highlighted with the `region' face whenever the mark
+is active. The mark is \"deactivated\" by changing the buffer,
+and after certain other operations that set the mark but whose
+main purpose is something else--for example, incremental search,
+\\[beginning-of-buffer], and \\[end-of-buffer].
You can also deactivate the mark by typing \\[keyboard-quit] or
\\[keyboard-escape-quit].
(declare-function font-info "font.c" (name &optional frame))
(defun default-font-height ()
- "Return the height in pixels of the current buffer's default face font."
+ "Return the height in pixels of the current buffer's default face font.
+
+If the default font is remapped (see `face-remapping-alist'), the
+function returns the height of the remapped face."
(let ((default-font (face-font 'default)))
(cond
((and (display-multi-font-p)
(aref (font-info default-font) 3))
(t (frame-char-height)))))
+(defun default-font-width ()
+ "Return the width in pixels of the current buffer's default face font.
+
+If the default font is remapped (see `face-remapping-alist'), the
+function returns the width of the remapped face."
+ (let ((default-font (face-font 'default)))
+ (cond
+ ((and (display-multi-font-p)
+ ;; Avoid calling font-info if the frame's default font was
+ ;; not changed since the frame was created. That's because
+ ;; font-info is expensive for some fonts, see bug #14838.
+ (not (string= (frame-parameter nil 'font) default-font)))
+ (let* ((info (font-info (face-font 'default)))
+ (width (aref info 11)))
+ (if (> width 0)
+ width
+ (aref info 10))))
+ (t (frame-char-width)))))
+
(defun default-line-height ()
"Return the pixel height of current buffer's default-face text line.
;; processed. This is consistent with the way main in emacs.c
;; does things.
(while (and (not done) args)
- (let* ((longopts '(("--no-init-file") ("--no-site-file") ("--debug-init")
+ (let* ((longopts '(("--no-init-file") ("--no-site-file")
+ ("--no-x-resources") ("--debug-init")
("--user") ("--iconic") ("--icon-type") ("--quick")
("--no-blinking-cursor") ("--basic-display")))
(argi (pop args))
((member argi '("-Q" "-quick"))
(setq init-file-user nil
site-run-file nil
- inhibit-x-resources t))
+ inhibit-x-resources t))
+ ((member argi '("-no-x-resources"))
+ (setq inhibit-x-resources t))
((member argi '("-D" "-basic-display"))
(setq no-blinking-cursor t
emacs-basic-display t)
The result is a new function which does the same as FUN, except that
the first N arguments are fixed at the values with which this function
was called."
- `(closure (t) (&rest args)
- (apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args)))
+ (lambda (&rest args2)
+ (apply fun (append args args2))))
(defmacro push (newelt place)
"Add NEWELT to the list stored in the generalized variable PLACE.
(unless parent (setq parent 'error))
(let ((conditions
(if (consp parent)
- (apply #'nconc
+ (apply #'append
(mapcar (lambda (parent)
(cons parent
(or (get parent 'error-conditions)
(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 'indirect-function '(object) "25.1")
(set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3")
(set-advertised-calling-convention 'decode-char '(ch charset) "21.4")
(set-advertised-calling-convention 'encode-char '(ch charset) "21.4")
\f
;;;; Process stuff.
+(defun start-process (name buffer program &rest program-args)
+ "Start a program in a subprocess. Return the process object for it.
+NAME is name for process. It is modified if necessary to make it unique.
+BUFFER is the buffer (or buffer name) to associate with the process.
+
+Process output (both standard output and standard error streams) goes
+at end of BUFFER, unless you specify an output stream or filter
+function to handle the output. BUFFER may also be nil, meaning that
+this process is not associated with any buffer.
+
+PROGRAM is the program file name. It is searched for in `exec-path'
+\(which see). If nil, just associate a pty with the buffer. Remaining
+arguments are strings to give program as arguments.
+
+If you want to separate standard output from standard error, invoke
+the command through a shell and redirect one of them using the shell
+syntax."
+ (unless (fboundp 'make-process)
+ (error "Emacs was compiled without subprocess support"))
+ (apply #'make-process
+ (append (list :name name :buffer buffer)
+ (if program
+ (list :command (cons program program-args))))))
+
(defun process-lines (program &rest args)
"Execute PROGRAM with ARGS, returning its output as a list of lines.
Signal an error if the program returns with a non-zero exit status."
(make-local-variable 'term-scroll-show-maximum-output)
(make-local-variable 'term-ptyp)
(make-local-variable 'term-exec-hook)
- (make-local-variable 'term-vertical-motion)
+ (set (make-local-variable 'term-vertical-motion) 'vertical-motion)
(set (make-local-variable 'term-pending-delete-marker) (make-marker))
(make-local-variable 'term-current-face)
(term-ansi-reset)
(set (make-local-variable 'font-lock-defaults) '(nil t))
+ (add-function :filter-return
+ (local 'window-adjust-process-window-size-function)
+ (lambda (size)
+ (when size
+ (term-reset-size (cdr size) (car size)))
+ size))
+
(easy-menu-add term-terminal-menu)
(easy-menu-add term-signals-menu)
(or term-input-ring
(goto-char save-point)))
found))
-(defun term-check-size (process)
- (when (or (/= term-height (window-text-height))
- (/= term-width (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)
(deactivate-mark)
(let ((proc (get-buffer-process (current-buffer))))
(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)))
+ (setf term-vertical-motion
+ (if (eq (window-buffer) (current-buffer))
+ 'vertical-motion
+ 'term-buffer-vertical-motion))
+ (setq save-marker (copy-marker (process-mark proc)))
(goto-char (process-mark proc))
(save-restriction
(eq (window-buffer selected) (current-buffer)))
(term-display-line (car term-pending-frame)
(cdr term-pending-frame))
- (setq term-pending-frame nil)
- ;; We have created a new window, so check the window size.
- (term-check-size proc))
+ (setq term-pending-frame nil))
;; Scroll each window displaying the buffer but (by default)
;; only if the point matches the process-mark we started with.
;; Create the other half by mirroring the first half.
(setq both-halves
(append first-half
- (mapc
+ (mapcar
(lambda (i)
(artist-new-fill-item (artist-fill-item-get-x i)
(- (artist-fill-item-get-y i))
-;;; css-mode.el --- Major mode to edit CSS files -*- lexical-binding: t -*-
+;;; css-mode.el --- Major mode to edit CSS files -*- lexical-binding: t -*-
;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Maintainer: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords: hypermedia
;; This file is part of GNU Emacs.
;; - electric ; and }
;; - filling code with auto-fill-mode
-;; - completion
+;; - attribute value completion
;; - fix font-lock errors with multi-line selectors
;;; Code:
"Cascading Style Sheets (CSS) editing mode."
:group 'languages)
+(defconst css-pseudo-class-ids
+ '("active" "checked" "disabled" "empty" "enabled" "first"
+ "first-child" "first-of-type" "focus" "hover" "indeterminate" "lang"
+ "last-child" "last-of-type" "left" "link" "nth-child"
+ "nth-last-child" "nth-last-of-type" "nth-of-type" "only-child"
+ "only-of-type" "right" "root" "target" "visited")
+ "Identifiers for pseudo-classes.")
-(defun css-extract-keyword-list (res)
- (with-temp-buffer
- (url-insert-file-contents "http://www.w3.org/TR/REC-CSS2/css2.txt")
- (goto-char (point-max))
- (search-backward "Appendix H. Index")
- (forward-line)
- (delete-region (point-min) (point))
- (let ((result nil)
- keys)
- (dolist (re res)
- (goto-char (point-min))
- (setq keys nil)
- (while (re-search-forward (cdr re) nil t)
- (push (match-string 1) keys))
- (push (cons (car re) (sort keys 'string-lessp)) result))
- (nreverse result))))
-
-(defun css-extract-parse-val-grammar (string env)
- (let ((start 0)
- (elems ())
- name)
- (while (string-match
- (concat "\\(?:"
- (concat "<a [^>]+><span [^>]+>\\(?:"
- "<\\([^&]+\\)>\\|'\\([^']+\\)'"
- "\\)</span></a>")
- "\\|" "\\(\\[\\)"
- "\\|" "\\(]\\)"
- "\\|" "\\(||\\)"
- "\\|" "\\(|\\)"
- "\\|" "\\([*+?]\\)"
- "\\|" "\\({[^}]+}\\)"
- "\\|" "\\(\\w+\\(?:-\\w+\\)*\\)"
- "\\)[ \t\n]*")
- string start)
- ;; (assert (eq start (match-beginning 0)))
- (setq start (match-end 0))
- (cond
- ;; Reference to a type of value.
- ((setq name (match-string-no-properties 1 string))
- (push (intern name) elems))
- ;; Reference to another property's values.
- ((setq name (match-string-no-properties 2 string))
- (setq elems (delete-dups (append (cdr (assoc name env)) elems))))
- ;; A literal
- ((setq name (match-string-no-properties 9 string))
- (push name elems))
- ;; We just ignore the rest. I.e. we ignore the structure because
- ;; it's too difficult to exploit anyway (it would allow us to only
- ;; complete top/center/bottom after one of left/center/right and
- ;; vice-versa).
- (t nil)))
- elems))
-
-
-(defun css-extract-props-and-vals ()
- (with-temp-buffer
- (url-insert-file-contents "http://www.w3.org/TR/CSS21/propidx.html")
- (goto-char (point-min))
- (let ((props ()))
- (while (re-search-forward "#propdef-\\([^\"]+\\)\"><span class=\"propinst-\\1 xref\">'\\1'</span></a>" nil t)
- (let ((prop (match-string-no-properties 1)))
- (save-excursion
- (goto-char (match-end 0))
- (search-forward "<td>")
- (let ((vals-string (buffer-substring (point)
- (progn
- (re-search-forward "[ \t\n]+|[ \t\n]+<a href=\"cascade.html#value-def-inherit\" class=\"noxref\"><span class=\"value-inst-inherit\">inherit</span></a>")
- (match-beginning 0)))))
- ;;
- (push (cons prop (css-extract-parse-val-grammar vals-string props))
- props)))))
- props)))
-
-;; Extraction was done with:
-;; (css-extract-keyword-list
-;; '((pseudo . "^ +\\* :\\([^ \n,]+\\)")
-;; (at . "^ +\\* @\\([^ \n,]+\\)")
-;; (descriptor . "^ +\\* '\\([^ '\n]+\\)' (descriptor)")
-;; (media . "^ +\\* '\\([^ '\n]+\\)' media group")
-;; (property . "^ +\\* '\\([^ '\n]+\\)',")))
-
-(defconst css-pseudo-ids
- '("active" "after" "before" "first" "first-child" "first-letter" "first-line"
- "focus" "hover" "lang" "left" "link" "right" "visited")
- "Identifiers for pseudo-elements and pseudo-classes.")
+(defconst css-pseudo-element-ids
+ '("after" "before" "first-letter" "first-line")
+ "Identifiers for pseudo-elements.")
(defconst css-at-ids
- '("charset" "font-face" "import" "media" "page")
+ '("charset" "font-face" "import" "media" "namespace" "page")
"Identifiers that appear in the form @foo.")
(defconst css-descriptor-ids
"Identifiers for types of media.")
(defconst css-property-ids
- '("azimuth" "background" "background-attachment" "background-color"
- "background-image" "background-position" "background-repeat" "block"
- "border" "border-bottom" "border-bottom-color" "border-bottom-style"
- "border-bottom-width" "border-collapse" "border-color" "border-left"
- "border-left-color" "border-left-style" "border-left-width" "border-right"
+ '(;; CSS 2.1 properties (http://www.w3.org/TR/CSS21/propidx.html).
+ ;;
+ ;; Properties duplicated by any of the CSS3 modules below have
+ ;; been removed.
+ "azimuth" "border-collapse" "border-spacing" "bottom"
+ "caption-side" "clear" "clip" "content" "counter-increment"
+ "counter-reset" "cue" "cue-after" "cue-before" "direction" "display"
+ "elevation" "empty-cells" "float" "height" "left" "line-height"
+ "list-style" "list-style-image" "list-style-position"
+ "list-style-type" "margin" "margin-bottom" "margin-left"
+ "margin-right" "margin-top" "max-height" "max-width" "min-height"
+ "min-width" "orphans" "overflow" "padding" "padding-bottom"
+ "padding-left" "padding-right" "padding-top" "page-break-after"
+ "page-break-before" "page-break-inside" "pause" "pause-after"
+ "pause-before" "pitch" "pitch-range" "play-during" "position"
+ "quotes" "richness" "right" "speak" "speak-header" "speak-numeral"
+ "speak-punctuation" "speech-rate" "stress" "table-layout" "top"
+ "unicode-bidi" "vertical-align" "visibility" "voice-family" "volume"
+ "widows" "width" "z-index"
+
+ ;; CSS Animations
+ ;; (http://www.w3.org/TR/css3-animations/#property-index)
+ "animation" "animation-delay" "animation-direction"
+ "animation-duration" "animation-fill-mode"
+ "animation-iteration-count" "animation-name"
+ "animation-play-state" "animation-timing-function"
+
+ ;; CSS Backgrounds and Borders Module Level 3
+ ;; (http://www.w3.org/TR/css3-background/#property-index)
+ "background" "background-attachment" "background-clip"
+ "background-color" "background-image" "background-origin"
+ "background-position" "background-repeat" "background-size"
+ "border" "border-bottom" "border-bottom-color"
+ "border-bottom-left-radius" "border-bottom-right-radius"
+ "border-bottom-style" "border-bottom-width" "border-color"
+ "border-image" "border-image-outset" "border-image-repeat"
+ "border-image-slice" "border-image-source" "border-image-width"
+ "border-left" "border-left-color" "border-left-style"
+ "border-left-width" "border-radius" "border-right"
"border-right-color" "border-right-style" "border-right-width"
- "border-spacing" "border-style" "border-top" "border-top-color"
- "border-top-style" "border-top-width" "border-width" "bottom"
- "caption-side" "clear" "clip" "color" "compact" "content"
- "counter-increment" "counter-reset" "cue" "cue-after" "cue-before"
- "cursor" "dashed" "direction" "display" "dotted" "double" "elevation"
- "empty-cells" "float" "font" "font-family" "font-size" "font-size-adjust"
- "font-stretch" "font-style" "font-variant" "font-weight" "groove" "height"
- "hidden" "inline" "inline-table" "inset" "left" "letter-spacing"
- "line-height" "list-item" "list-style" "list-style-image"
- "list-style-position" "list-style-type" "margin" "margin-bottom"
- "margin-left" "margin-right" "margin-top" "marker-offset" "marks"
- "max-height" "max-width" "min-height" "min-width" "orphans" "outline"
- "outline-color" "outline-style" "outline-width" "outset" "overflow"
- "padding" "padding-bottom" "padding-left" "padding-right" "padding-top"
- "page" "page-break-after" "page-break-before" "page-break-inside" "pause"
- "pause-after" "pause-before" "pitch" "pitch-range" "play-during" "position"
- "quotes" "richness" "ridge" "right" "run-in" "size" "solid" "speak"
- "speak-header" "speak-numeral" "speak-punctuation" "speech-rate" "stress"
- "table" "table-caption" "table-cell" "table-column" "table-column-group"
- "table-footer-group" "table-header-group" "table-layout" "table-row"
- "table-row-group" "text-align" "text-decoration" "text-indent"
- "text-shadow" "text-transform" "top" "unicode-bidi" "vertical-align"
- "visibility" "voice-family" "volume" "white-space" "widows" "width"
- "word-spacing" "z-index")
+ "border-style" "border-top" "border-top-color"
+ "border-top-left-radius" "border-top-right-radius"
+ "border-top-style" "border-top-width" "border-width" "box-shadow"
+
+ ;; CSS Basic User Interface Module Level 3 (CSS3 UI)
+ ;; (http://www.w3.org/TR/css3-ui/#property-index)
+ "box-sizing" "caret-color" "cursor" "nav-down" "nav-left"
+ "nav-right" "nav-up" "outline" "outline-color" "outline-offset"
+ "outline-style" "outline-width" "resize" "text-overflow"
+
+ ;; CSS Color Module Level 3
+ ;; (http://www.w3.org/TR/css3-color/#property)
+ "color" "opacity"
+
+ ;; CSS Flexible Box Layout Module Level 1
+ ;; (http://www.w3.org/TR/css-flexbox-1/#property-index)
+ "align-content" "align-items" "align-self" "flex" "flex-basis"
+ "flex-direction" "flex-flow" "flex-grow" "flex-shrink" "flex-wrap"
+ "justify-content" "order"
+
+ ;; CSS Fonts Module Level 3
+ ;; (http://www.w3.org/TR/css3-fonts/#property-index)
+ "font" "font-family" "font-feature-settings" "font-kerning"
+ "font-language-override" "font-size" "font-size-adjust"
+ "font-stretch" "font-style" "font-synthesis" "font-variant"
+ "font-variant-alternates" "font-variant-caps"
+ "font-variant-east-asian" "font-variant-ligatures"
+ "font-variant-numeric" "font-variant-position" "font-weight"
+
+ ;; CSS Text Decoration Module Level 3
+ ;; (http://dev.w3.org/csswg/css-text-decor-3/#property-index)
+ "text-decoration" "text-decoration-color" "text-decoration-line"
+ "text-decoration-skip" "text-decoration-style" "text-emphasis"
+ "text-emphasis-color" "text-emphasis-position" "text-emphasis-style"
+ "text-shadow" "text-underline-position"
+
+ ;; CSS Text Module Level 3
+ ;; (http://www.w3.org/TR/css3-text/#property-index)
+ "hanging-punctuation" "hyphens" "letter-spacing" "line-break"
+ "overflow-wrap" "tab-size" "text-align" "text-align-last"
+ "text-indent" "text-justify" "text-transform" "white-space"
+ "word-break" "word-spacing" "word-wrap"
+
+ ;; CSS Transforms Module Level 1
+ ;; (http://www.w3.org/TR/css3-2d-transforms/#property-index)
+ "backface-visibility" "perspective" "perspective-origin"
+ "transform" "transform-origin" "transform-style"
+
+ ;; CSS Transitions
+ ;; (http://www.w3.org/TR/css3-transitions/#property-index)
+ "transition" "transition-delay" "transition-duration"
+ "transition-property" "transition-timing-function"
+
+ ;; Filter Effects Module Level 1
+ ;; (http://www.w3.org/TR/filter-effects/#property-index)
+ "color-interpolation-filters" "filter" "flood-color"
+ "flood-opacity" "lighting-color")
"Identifiers for properties.")
(defcustom css-electric-keys '(?\} ?\;) ;; '()
(concat "\\(?:" scss--hash-re
"\\|[^@/:{} \t\n#]\\)"
"[^:{}#]*\\(?:" scss--hash-re "[^:{}#]*\\)*"))
- "\\(?::" (regexp-opt css-pseudo-ids t)
+ ;; Even though pseudo-elements should be prefixed by ::, a
+ ;; single colon is accepted for backward compatibility.
+ "\\(?:\\(:" (regexp-opt (append css-pseudo-class-ids
+ css-pseudo-element-ids) t)
+ "\\|\\::" (regexp-opt css-pseudo-element-ids t) "\\)"
"\\(?:([^\)]+)\\)?"
(if (not sassy)
"[^:{}\n]*"
(`(:elem . basic) css-indent-offset)
(`(:elem . arg) 0)
(`(:list-intro . ,(or `";" `"")) t) ;"" stands for BOB (bug#15467).
- (`(:before . "{") (if (smie-rule-hanging-p)
- (smie-rule-parent 0)))))
+ (`(:before . ,(or "{" "("))
+ (if (smie-rule-hanging-p) (smie-rule-parent 0)))))
+
+;;; Completion
+
+(defun css--complete-property ()
+ "Complete property at point."
+ (save-excursion
+ (let ((pos (point)))
+ (skip-chars-backward "-[:alnum:]")
+ (let ((start (point)))
+ (skip-chars-backward " \t\r\n")
+ (when (memq (char-before) '(?\{ ?\;))
+ (list start pos css-property-ids))))))
+
+(defun css--complete-pseudo-element-or-class ()
+ "Complete pseudo-element or pseudo-class at point."
+ (save-excursion
+ (let ((pos (point)))
+ (skip-chars-backward "-[:alnum:]")
+ (when (eq (char-before) ?\:)
+ (list (point) pos
+ (if (eq (char-before (- (point) 1)) ?\:)
+ css-pseudo-element-ids
+ css-pseudo-class-ids))))))
+
+(defun css--complete-at-rule ()
+ "Complete at-rule (statement beginning with `@') at point."
+ (save-excursion
+ (let ((pos (point)))
+ (skip-chars-backward "-[:alnum:]")
+ (when (eq (char-before) ?\@)
+ (list (point) pos css-at-ids)))))
+
+(defun css-completion-at-point ()
+ "Complete current symbol at point.
+Currently supports completion of CSS properties, pseudo-elements,
+pseudo-classes, and at-rules."
+ (or (css--complete-property)
+ (css--complete-pseudo-element-or-class)
+ (css--complete-at-rule)))
;;;###autoload
-(define-derived-mode css-mode fundamental-mode "CSS"
+(define-derived-mode css-mode prog-mode "CSS"
"Major mode to edit Cascading Style Sheets."
(setq-local font-lock-defaults css-font-lock-defaults)
(setq-local comment-start "/*")
(setq-local comment-start-skip "/\\*+[ \t]*")
(setq-local comment-end "*/")
(setq-local comment-end-skip "[ \t]*\\*+/")
- (setq-local parse-sexp-ignore-comments t)
(setq-local fill-paragraph-function 'css-fill-paragraph)
(setq-local add-log-current-defun-function #'css-current-defun-name)
(smie-setup css-smie-grammar #'css-smie-rules
:forward-token #'css-smie--forward-token
:backward-token #'css-smie--backward-token)
(setq-local electric-indent-chars
- (append css-electric-keys electric-indent-chars)))
+ (append css-electric-keys electric-indent-chars))
+ (add-hook 'completion-at-point-functions
+ #'css-completion-at-point nil 'local))
(defvar comment-continue)
(cond
;; This is a false positive inside a string or comment.
((nth 8 (syntax-ppss)) nil)
+ ;; This is a false positive when encountering an
+ ;; interpolated variable (bug#19751).
+ ((eq (char-before (- (point) 1)) ?#) nil)
((eq (char-before) ?\})
(save-excursion
(forward-char -1)
(skip-chars-backward " \t")
- (unless (bolp) (newline))))
+ (when (and (not (bolp))
+ (scss-smie--not-interpolation-p))
+ (newline))))
(t
(while
(progn
(defun scss-smie--not-interpolation-p ()
(save-excursion
(forward-char -1)
- (or (zerop (skip-chars-backward "[:alnum:]"))
+ (or (zerop (skip-chars-backward "-[:alnum:]"))
(not (looking-back "#{\\$" (- (point) 3))))))
;;;###autoload (add-to-list 'auto-mode-alist '("\\.scss\\'" . scss-mode))
-;;; flyspell.el --- on-the-fly spell checker
+;;; flyspell.el --- On-the-fly spell checker -*- lexical-binding:t -*-
;; Copyright (C) 1998, 2000-2015 Free Software Foundation, Inc.
;;; Code:
(require 'ispell)
+(eval-when-compile (require 'cl-lib))
;;*---------------------------------------------------------------------*/
;;* Group ... */
:version "21.1"
:type 'boolean)
-(defcustom flyspell-duplicate-distance -1
+(defcustom flyspell-duplicate-distance 400000
"The maximum distance for finding duplicates of unrecognized words.
This applies to the feature that when a word is not found in the dictionary,
if the same spelling occurs elsewhere in the buffer,
-1 means no limit (search the whole buffer).
0 means do not search for duplicate unrecognized spellings."
:group 'flyspell
- :version "21.1"
+ :version "24.5" ; -1 -> 400000
:type '(choice (const :tag "no limit" -1)
number))
Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate'
property of the major mode name.")
(make-variable-buffer-local 'flyspell-generic-check-word-predicate)
-(defvaralias 'flyspell-generic-check-word-p
- 'flyspell-generic-check-word-predicate)
+(define-obsolete-variable-alias 'flyspell-generic-check-word-p
+ 'flyspell-generic-check-word-predicate "25.1")
;;*--- mail mode -------------------------------------------------------*/
(put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
(defvar message-signature-separator)
(defun mail-mode-flyspell-verify ()
"Function used for `flyspell-generic-check-word-predicate' in Mail mode."
- (let ((header-end (save-excursion
- (goto-char (point-min))
- (re-search-forward
- (concat "^"
- (regexp-quote mail-header-separator)
- "$")
- nil t)
- (point)))
- (signature-begin
- (if (not (boundp 'message-signature-separator))
- (point-max)
- (save-excursion
- (goto-char (point-max))
- (re-search-backward message-signature-separator nil t)
- (point)))))
+ (let* ((header-end (save-excursion
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^\\(?:"
+ (regexp-quote mail-header-separator)
+ "\\)?$")
+ nil t)
+ (point)))
+ (signature-begin
+ (if (not (boundp 'message-signature-separator))
+ (point-max)
+ (save-excursion
+ (goto-char (point-max))
+ (re-search-backward message-signature-separator
+ (max header-end (- (point) 4000)) t)
+ (point)))))
(cond ((< (point) header-end)
(and (save-excursion (beginning-of-line)
(looking-at "^Subject:"))
"Turn on `flyspell-mode' for comments and strings."
(interactive)
(setq flyspell-generic-check-word-predicate
- 'flyspell-generic-progmode-verify)
+ #'flyspell-generic-progmode-verify)
(flyspell-mode 1)
(run-hooks 'flyspell-prog-mode-hook))
;;*---------------------------------------------------------------------*/
;;* flyspell-after-change-function ... */
;;*---------------------------------------------------------------------*/
-(defun flyspell-after-change-function (start stop len)
+(defun flyspell-after-change-function (start stop _len)
"Save the current buffer and point for Flyspell's post-command hook."
(push (cons start stop) flyspell-changes))
;;*---------------------------------------------------------------------*/
(defun flyspell-word-search-backward (word bound &optional ignore-case)
(save-excursion
- (let ((r '())
- (inhibit-point-motion-hooks t)
- p)
- (while (and (not r) (setq p (search-backward word bound t)))
- (let ((lw (flyspell-get-word)))
- (if (and (consp lw)
- (if ignore-case
- (string-equal (downcase (car lw)) (downcase word))
- (string-equal (car lw) word)))
- (setq r p)
- (goto-char p))))
+ (let* ((r '())
+ (inhibit-point-motion-hooks t)
+ (flyspell-not-casechars (flyspell-get-not-casechars))
+ (bound (if (and bound
+ (> bound (point-min)))
+ (- bound 1)))
+ (word-re (concat
+ "\\(?:" flyspell-not-casechars "\\|\\`\\)"
+ (regexp-quote word)
+ flyspell-not-casechars))
+ p)
+ (while
+ (and (not r)
+ (setq p
+ (and
+ (re-search-backward word-re bound t)
+ (if (bobp)
+ (point)
+ (forward-char)
+ (point)))))
+ (let ((lw (flyspell-get-word)))
+ (if (and (consp lw)
+ (if ignore-case
+ (string-equal (downcase (car lw)) (downcase word))
+ (string-equal (car lw) word)))
+ (setq r p)
+ (goto-char p))))
r)))
;;*---------------------------------------------------------------------*/
;;*---------------------------------------------------------------------*/
(defun flyspell-word-search-forward (word bound)
(save-excursion
- (let ((r '())
- (inhibit-point-motion-hooks t)
- p)
- (while (and (not r) (setq p (search-forward word bound t)))
- (let ((lw (flyspell-get-word)))
- (if (and (consp lw) (string-equal (car lw) word))
- (setq r p)
- (goto-char (1+ p)))))
+ (let* ((r '())
+ (inhibit-point-motion-hooks t)
+ (flyspell-not-casechars (flyspell-get-not-casechars))
+ (bound (if (and bound
+ (< bound (point-max)))
+ (+ bound 1)))
+ (word-re (concat flyspell-not-casechars
+ (regexp-quote word)
+ "\\(?:" flyspell-not-casechars "\\|\\'\\)"))
+ p)
+ (while
+ (and (not r)
+ (setq p (and
+ (re-search-forward word-re bound t)
+ (if (eobp)
+ (point)
+ (backward-char)
+ (point)))))
+ (let ((lw (flyspell-get-word)))
+ (if (and (consp lw) (string-equal (car lw) word))
+ (setq r p)
+ (goto-char (1+ p)))))
r)))
+(defvar flyspell-word) ;Backward compatibility; some predicates made use of it!
+
;;*---------------------------------------------------------------------*/
;;* flyspell-word ... */
;;*---------------------------------------------------------------------*/
;; end of last validated match.
(setq buffer-scan-pos (point))))
;; Record if misspelling is not found and try new one
- (add-to-list 'words-not-found
- (concat " -> " word " - "
- (int-to-string wordpos)))
+ (cl-pushnew (concat " -> " word " - "
+ (int-to-string wordpos))
+ words-not-found :test #'equal)
(setq keep nil)))))))
;; we are done
(if flyspell-issue-message-flag (message "Spell Checking completed.")))
(let ((extended-char-mode (ispell-get-extended-character-mode)))
(and extended-char-mode ; ~ extended character mode
(string-match "[^~]+$" extended-char-mode)
- (add-to-list 'args (concat "-T" (match-string 0 extended-char-mode)))))
+ (cl-pushnew (concat "-T" (match-string 0 extended-char-mode))
+ args :test #'equal)))
;; Add ispell-extra-args
(setq args (append args ispell-extra-args))
(make-obsolete-variable 'ispell-aspell-supports-utf8
'ispell-encoding8-command "23.1")
-(defvar ispell-hunspell-dictionary-equivs-alist
+(defvar ispell-dicts-name2locale-equivs-alist
'(("american" "en_US")
("brasileiro" "pt_BR")
("british" "en_GB")
("slovenian" "sl_SI")
("svenska" "sv_SE")
("hebrew" "he_IL"))
- "Alist with matching hunspell dict names for standard dict names in
+ "Alist with known matching locales for standard dict names in
`ispell-dictionary-base-alist'.")
(defvar ispell-emacs-alpha-regexp
"For aspell dictionary DICT-NAME, return a list of parameters if an
associated data file is found or nil otherwise. List format is that
of `ispell-dictionary-base-alist' elements."
+
+ ;; Make sure `ispell-aspell-dict-dir' is defined
+ (or ispell-aspell-dict-dir
+ (setq ispell-aspell-dict-dir
+ (ispell-get-aspell-config-value "dict-dir")))
+
;; Make sure `ispell-aspell-data-dir' is defined
(or ispell-aspell-data-dir
(setq ispell-aspell-data-dir
(ispell-get-aspell-config-value "data-dir")))
- ;; Try finding associated datafile
- (let* ((datafile1
- (concat ispell-aspell-data-dir "/"
- ;; Strip out variant, country code, etc.
- (and (string-match "^[[:alpha:]]+" dict-name)
- (match-string 0 dict-name)) ".dat"))
- (datafile2
- (concat ispell-aspell-data-dir "/"
- ;; Strip out anything but xx_YY.
- (and (string-match "^[[:alpha:]_]+" dict-name)
- (match-string 0 dict-name)) ".dat"))
- (data-file
- (if (file-readable-p datafile1)
- datafile1
- (if (file-readable-p datafile2)
- datafile2)))
- otherchars)
+
+ ;; Try finding associated datafile. aspell will look for master .dat
+ ;; file in `dict-dir' and `data-dir'. Associated .dat files must be
+ ;; in the same directory as master file.
+ (let ((data-file
+ (catch 'datafile
+ (dolist ( tmp-path (list ispell-aspell-dict-dir
+ ispell-aspell-data-dir ))
+ ;; Try xx.dat first, strip out variant, country code, etc,
+ ;; then try xx_YY.dat (without stripping country code).
+ (dolist (tmp-regexp (list "^[[:alpha:]]+"
+ "^[[:alpha:]_]+"))
+ (let ((fullpath
+ (concat tmp-path "/"
+ (and (string-match tmp-regexp dict-name)
+ (match-string 0 dict-name)) ".dat")))
+ (if (file-readable-p fullpath)
+ (throw 'datafile fullpath)))))))
+ otherchars)
(if data-file
(with-temp-buffer
(realdict (assoc realname alist)))
(when (and realdict (not already-exists-p))
(push (cons aliasname (cdr realdict)) alist))))))
+ ;; Add entries for standard dict-names with found locale-matching entry
+ (dolist (dict-map-entry ispell-dicts-name2locale-equivs-alist)
+ (let ((name (car dict-map-entry))
+ (locale (cadr dict-map-entry)))
+ (unless (assoc name alist) ;; skip if already present
+ (if (assoc locale alist)
+ (push (cons name (cdr (assoc locale alist))) alist)))))
alist))
;; Make ispell.el work better with hunspell.
(if (cadr (assoc dict ispell-dictionary-alist))
(message "ispell-hfde: Non void entry for %s. Skipping.\n" dict)
(let ((dict-alias
- (cadr (assoc dict ispell-hunspell-dictionary-equivs-alist)))
+ (cadr (assoc dict ispell-dicts-name2locale-equivs-alist)))
(use-for-dicts (list dict))
(dict-args-cdr (cdr (ispell-parse-hunspell-affix-file dict)))
newlist)
;; Get a list of uninitialized dicts using the same affix file.
- (dolist (dict-equiv-alist-entry ispell-hunspell-dictionary-equivs-alist)
+ (dolist (dict-equiv-alist-entry ispell-dicts-name2locale-equivs-alist)
(let ((dict-equiv-key (car dict-equiv-alist-entry))
(dict-equiv-value (cadr dict-equiv-alist-entry)))
(if (or (member dict dict-equiv-alist-entry)
"Look for installed hunspell dictionaries.
Will initialize `ispell-hunspell-dictionary-alist' and
`ispell-hunspell-dictionary-alist' after values found
-and remove `ispell-hunspell-dictionary-equivs-alist'
+and remove `ispell-dicts-name2locale-equivs-alist'
entries if a specific dict was found."
(let ((hunspell-found-dicts
(split-string
"-- ispell-fhd: Skipping entry: %s\n" dict)))))
;; Remove entry from aliases alist if explicit dict was found.
(let (newlist)
- (dolist (dict ispell-hunspell-dictionary-equivs-alist)
+ (dolist (dict ispell-dicts-name2locale-equivs-alist)
(if (assoc (car dict) ispell-hunspell-dict-paths-alist)
(ispell-print-if-debug
"-- ispell-fhd: Excluding %s alias. Standalone dict found.\n"
(car dict))
(add-to-list 'newlist dict)))
- (setq ispell-hunspell-dictionary-equivs-alist newlist))
+ (setq ispell-dicts-name2locale-equivs-alist newlist))
;; Add known hunspell aliases
- (dolist (dict-equiv ispell-hunspell-dictionary-equivs-alist)
+ (dolist (dict-equiv ispell-dicts-name2locale-equivs-alist)
(let ((dict-equiv-key (car dict-equiv))
(dict-equiv-value (cadr dict-equiv))
(exclude-aliases (list ;; Exclude TeX aliases
(let* ((dict-name (nth 0 adict))
(dict-equiv
(cadr (assoc dict-name
- ispell-hunspell-dictionary-equivs-alist)))
+ ispell-dicts-name2locale-equivs-alist)))
(ispell-args (nth 5 adict))
(ispell-args-has-d (member "-d" ispell-args))
skip-dict)
The file name is expected after the command, either in braces or separated
by whitespace."
:group 'reftex-table-of-contents-browser
+ :set 'reftex-set-dirty
:type '(repeat string))
(defcustom reftex-max-section-depth 12
(string :tag ""))
(option (boolean :tag "Downcase words "))))
-(defcustom reftex-label-regexps
- '(;; Normal \\label{foo} labels
- "\\\\label{\\(?1:[^}]*\\)}"
- ;; keyvals [..., label = {foo}, ...] forms used by ctable,
- ;; listings, minted, ...
- "\\[[^]]*\\<label[[:space:]]*=[[:space:]]*{?\\(?1:[^],}]+\\)}?")
- "List of regexps matching \\label definitions.
+(if (featurep 'xemacs)
+ ;; XEmacs 21.5 doesn't have explicitly numbered matching groups,
+ ;; so this list mustn't get any more items.
+ (defconst reftex-label-regexps '("\\\\label{\\([^}]*\\)}"))
+ (defcustom reftex-label-regexps
+ '(;; Normal \\label{foo} labels
+ "\\\\label{\\(?1:[^}]*\\)}"
+ ;; keyvals [..., label = {foo}, ...] forms used by ctable,
+ ;; listings, minted, ...
+ "\\[[^]]*\\<label[[:space:]]*=[[:space:]]*{?\\(?1:[^],}]+\\)}?")
+ "List of regexps matching \\label definitions.
The default value matches usual \\label{...} definitions and
keyval style [..., label = {...}, ...] label definitions. It is
assumed that the regexp group 1 matches the label text, so you
When changed from Lisp, make sure to call
`reftex-compile-variables' afterwards to make the change
effective."
- :version "24.4"
- :set (lambda (symbol value)
- (set symbol value)
- (when (fboundp 'reftex-compile-variables)
- (reftex-compile-variables)))
- :group 'reftex-defining-label-environments
- :type '(repeat (regexp :tag "Regular Expression")))
+ :version "24.4"
+ :set (lambda (symbol value)
+ (set symbol value)
+ (when (fboundp 'reftex-compile-variables)
+ (reftex-compile-variables)))
+ :group 'reftex-defining-label-environments
+ :type '(repeat (regexp :tag "Regular Expression"))))
(defcustom reftex-label-ignored-macros-and-environments nil
"List of macros and environments to be ignored when searching for labels.
:type 'integer
:group 'sgml)
+(defcustom sgml-attribute-offset 0
+ "Specifies a delta for attribute indentation in `sgml-indent-line'.
+
+When 0, attribute indentation looks like this:
+
+ <element
+ attribute=\"value\">
+ </element>
+
+When 2, attribute indentation looks like this:
+
+ <element
+ attribute=\"value\">
+ </element>"
+ :version "25.1"
+ :type 'integer
+ :safe 'integerp
+ :group 'sgml)
+
(defcustom sgml-xml-mode nil
"When non-nil, tag insertion functions will be XML-compliant.
It is set to be buffer-local when the file has
(`pi nil)
(`tag
- (goto-char (1+ (cdr lcon)))
+ (goto-char (+ (cdr lcon) sgml-attribute-offset))
(skip-chars-forward "^ \t\n") ;Skip tag name.
(skip-chars-forward " \t")
(if (not (eolp))
(current-column)
;; This is the first attribute: indent.
- (goto-char (1+ (cdr lcon)))
+ (goto-char (+ (cdr lcon) sgml-attribute-offset))
(+ (current-column) sgml-basic-offset)))
(`text
(modify-syntax-entry ?\\ ". " st)
;; We add `p' so that M-c on 'hello' leads to 'Hello' rather than 'hello'.
(modify-syntax-entry ?' "w p" st)
+ ;; UAX #29 says HEBREW PUNCTUATION GERESH behaves like a letter
+ ;; for the purposes of finding word boundaries.
+ (modify-syntax-entry #x5f3 "w ") ; GERESH
+ ;; UAX #29 says HEBREW PUNCTUATION GERSHAYIM should not be a word
+ ;; boundary when surrounded by letters. Our infrastructure for
+ ;; finding a word boundary doesn't support 3-character
+ ;; definitions, so for now simply make this a word-constituent
+ ;; character. This leaves a problem of having GERSHAYIM at the
+ ;; beginning or end of a word, where it should be a boundary;
+ ;; FIXME.
+ (modify-syntax-entry #x5f4 "w ") ; GERSHAYIM
+ ;; These all should not be a word boundary when between letters,
+ ;; according to UAX #29, so they again are prone to the same
+ ;; problem as GERSHAYIM; FIXME.
+ (modify-syntax-entry #xb7 "w ") ; MIDDLE DOT
+ (modify-syntax-entry #x2027 "w ") ; HYPHENATION POINT
+ (modify-syntax-entry #xff1a "w ") ; FULLWIDTH COLON
st)
"Syntax table used while in `text-mode'.")
+2015-03-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * url-handlers.el (url-insert-file-contents): Call
+ after-insert-file-set-coding like insert-file-contents, to set
+ buffer-file-coding-system (bug#20010).
+
2015-01-22 Paul Eggert <eggert@cs.ucla.edu>
Don't downcase system diagnostics' first letters
* url-dav.el (url-dav-delete-directory, url-dav-delete-file)
(url-dav-directory-files): Keep diagnostics consistent with system's.
+2015-01-17 Ivan Shmakov <ivan@siamics.net>
+
+ * url-cookie.el (url-cookie-write-file): Let-bind print-length
+ and print-level to nil to avoid writing a garbled list. (Bug#16805)
+
2014-12-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
* url-http.el (url-http-parse-headers): `gnutls-available-p' is
-;;; url-handlers.el --- file-name-handler stuff for URL loading
+;;; url-handlers.el --- file-name-handler stuff for URL loading -*- lexical-binding:t -*-
;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; a local process.
nil)))
-(defun url-handler-file-remote-p (filename &optional identification connected)
+(defun url-handler-file-remote-p (filename &optional identification _connected)
(let ((url (url-generic-parse-url filename)))
(if (and (url-type url) (not (equal (url-type url) "file")))
;; Maybe we can find a suitable check for CONNECTED. For now,
;; The actual implementation
;;;###autoload
(defun url-copy-file (url newname &optional ok-if-already-exists
- keep-time preserve-uid-gid)
+ _keep-time _preserve-uid-gid)
"Copy URL to NEWNAME. Both args must be strings.
Signals a `file-already-exists' error if file NEWNAME already exists,
unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
(unless (cadr size-and-charset)
;; If the headers don't specify any particular charset, use the
;; usual heuristic/rules that we apply to files.
- (decode-coding-inserted-region start (point) url visit beg end replace))
- (list url (car size-and-charset))))))
+ (decode-coding-inserted-region start (point) url
+ visit beg end replace))
+ (let ((inserted (car size-and-charset)))
+ (when (fboundp 'after-insert-file-set-coding)
+ (let ((insval (after-insert-file-set-coding inserted visit)))
+ (if insval (setq inserted insval))))
+ (list url inserted))))))
(put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents)
(repeat :tag "Argument List" :value ("") string))
:group 'vc-bzr)
+(defcustom vc-bzr-annotate-switches nil
+ "String or list of strings specifying switches for bzr annotate under VC.
+If nil, use the value of `vc-annotate-switches'. If t, use no switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "25.1"
+ :group 'vc-bzr)
+
(defcustom vc-bzr-log-switches nil
"String or list of strings specifying switches for bzr log under VC."
:type '(choice (const :tag "None" nil)
Each line is tagged with the revision number, which has a `help-echo'
property containing author and date information."
(apply #'vc-bzr-command "annotate" buffer 'async file "--long" "--all"
- (if revision (list "-r" revision)))
+ (append (vc-switches 'bzr 'annotate)
+ (if revision (list "-r" revision))))
(let ((table (make-hash-table :test 'equal)))
(set-process-filter
(get-buffer-process buffer)
:version "21.1"
:group 'vc-cvs)
+(defcustom vc-cvs-annotate-switches nil
+ "String or list of strings specifying switches for cvs annotate under VC.
+If nil, use the value of `vc-annotate-switches'. If t, use no
+switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "25.1"
+ :group 'vc-cvs)
+
(defcustom vc-cvs-header '("\$Id\$")
"Header keywords to be inserted by `vc-insert-headers'."
:version "24.1" ; no longer consult the obsolete vc-header-alist
(defun vc-cvs-annotate-command (file buffer &optional revision)
"Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER.
Optional arg REVISION is a revision to annotate from."
- (vc-cvs-command buffer
- (if (vc-cvs-stay-local-p file)
- 'async 0)
- file "annotate"
- (if revision (concat "-r" revision)))
+ (apply #'vc-cvs-command buffer
+ (if (vc-cvs-stay-local-p file)
+ 'async 0)
+ file "annotate"
+ (append (vc-switches 'cvs 'annotate)
+ (if revision (list (concat "-r" revision)))))
;; Strip the leading few lines.
(let ((proc (get-buffer-process buffer)))
(if proc
(if (and (not files) local (not (eq local 'only-file)))
(vc-cvs-dir-status-heuristic dir update-function)
(if (not files) (setq files (vc-expand-dirs (list dir) 'CVS)))
- (vc-cvs-command (current-buffer) 'async dir "-f" "status" files)
+ (vc-cvs-command (current-buffer) 'async files "-f" "status")
;; Alternative implementation: use the "update" command instead of
;; the "status" command.
;; (vc-cvs-command (current-buffer) 'async
:version "23.1"
:group 'vc-git)
+(defcustom vc-git-annotate-switches nil
+ "String or list of strings specifying switches for Git blame under VC.
+If nil, use the value of `vc-annotate-switches'. If t, use no switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "25.1"
+ :group 'vc-git)
+
(defcustom vc-git-program "git"
"Name of the Git executable (excluding any arguments)."
:version "24.1"
(defun vc-git-annotate-command (file buf &optional rev)
(let ((name (file-relative-name file)))
- (vc-git-command buf 'async nil "blame" "--date=iso" "-C" "-C" rev "--" name)))
+ (apply #'vc-git-command buf 'async nil "blame" "--date=iso"
+ (append (vc-switches 'git 'annotate)
+ (list rev "--" name)))))
(declare-function vc-annotate-convert-time "vc-annotate" (time))
:version "23.1"
:group 'vc-hg)
+(defcustom vc-hg-annotate-switches nil
+ "String or list of strings specifying switches for hg annotate under VC.
+If nil, use the value of `vc-annotate-switches'. If t, use no
+switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "25.1"
+ :group 'vc-hg)
+
(defcustom vc-hg-program "hg"
"Name of the Mercurial executable (excluding any arguments)."
:type 'string
(defun vc-hg-annotate-command (file buffer &optional revision)
"Execute \"hg annotate\" on FILE, inserting the contents in BUFFER.
Optional arg REVISION is a revision to annotate from."
- (vc-hg-command buffer 0 file "annotate" "-d" "-n" "--follow"
- (when revision (concat "-r" revision))))
+ (apply #'vc-hg-command buffer 0 file "annotate" "-d" "-n" "--follow"
+ (append (vc-switches 'hg 'annotate)
+ (if revision (list (concat "-r" revision))))))
(declare-function vc-annotate-convert-time "vc-annotate" (time))
;; - `copied' and `moved' (might be handled by `removed' and `added')
(or (vc-file-getprop file 'vc-state)
(when (> (length file) 0) ;Why?? --Stef
- (setq backend (or backend (vc-backend file)))
+ (setq backend (or backend (vc-responsible-backend file)))
(when backend
(vc-state-refresh file backend)))))
If FILE is not registered, this function always returns nil."
(or (vc-file-getprop file 'vc-working-revision)
(progn
- (setq backend (or backend (vc-backend file)))
+ (setq backend (or backend (vc-responsible-backend file)))
(when backend
(vc-file-setprop file 'vc-working-revision
(vc-call-backend backend 'working-revision file))))))
:version "23.1"
:group 'vc-mtn)
+(defcustom vc-mtn-annotate-switches nil
+ "String or list of strings specifying switches for mtn annotate under VC.
+If nil, use the value of `vc-annotate-switches'. If t, use no
+switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "25.1"
+ :group 'vc-mtn)
+
(define-obsolete-variable-alias 'vc-mtn-command 'vc-mtn-program "23.1")
(defcustom vc-mtn-program "mtn"
"Name of the monotone executable."
(if rev1 (list "-r" rev1)) (if rev2 (list "-r" rev2)))))
(defun vc-mtn-annotate-command (file buf &optional rev)
- (apply 'vc-mtn-command buf 'async file "annotate"
- (if rev (list "-r" rev))))
+ (apply #'vc-mtn-command buf 'async file "annotate"
+ (append (vc-switches 'mtn 'annotate)
+ (if rev (list "-r" rev)))))
(declare-function vc-annotate-convert-time "vc-annotate" (time))
"Unregister FILE from RCS.
If this leaves the RCS subdirectory empty, ask the user
whether to remove it."
- (let* ((master (vc-master-name file))
- (dir (file-name-directory master))
- (backup-info (find-backup-file-name master)))
- (if (not backup-info)
- (delete-file master)
- (rename-file master (car backup-info) 'ok-if-already-exists)
- (dolist (f (cdr backup-info)) (ignore-errors (delete-file f))))
- (and (string= (file-name-nondirectory (directory-file-name dir)) "RCS")
- ;; check whether RCS dir is empty, i.e. it does not
- ;; contain any files except "." and ".."
- (not (directory-files dir nil
- "^\\([^.]\\|\\.[^.]\\|\\.\\.[^.]\\).*"))
- (yes-or-no-p (format "Directory %s is empty; remove it? " dir))
- (delete-directory dir))))
+ (unless (memq (vc-state file) '(nil unregistered))
+ (let* ((master (vc-master-name file))
+ (dir (file-name-directory master))
+ (backup-info (find-backup-file-name master)))
+ (if (not backup-info)
+ (delete-file master)
+ (rename-file master (car backup-info) 'ok-if-already-exists)
+ (dolist (f (cdr backup-info)) (ignore-errors (delete-file f))))
+ (and (string= (file-name-nondirectory (directory-file-name dir)) "RCS")
+ ;; check whether RCS dir is empty, i.e. it does not
+ ;; contain any files except "." and ".."
+ (not (directory-files dir nil
+ "^\\([^.]\\|\\.[^.]\\|\\.\\.[^.]\\).*"))
+ (yes-or-no-p (format "Directory %s is empty; remove it? " dir))
+ (delete-directory dir)))))
;; It used to be possible to pass in a value for the variable rev, but
;; nothing in the rest of VC used this capability. Removing it makes the
This function sets the properties `vc-working-revision' and
`vc-checkout-model' to their correct values, based on the master
file."
- (with-temp-buffer
- (if (or (not (vc-insert-file (vc-master-name file) "^[0-9]"))
- (progn (goto-char (point-min))
- (not (looking-at "^head[ \t\n]+[^;]+;$"))))
- (error "File %s is not an RCS master file" (vc-master-name file)))
- (let ((workfile-is-latest nil)
- (default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1)))
- (vc-file-setprop file 'vc-rcs-default-branch default-branch)
- (unless working-revision
- ;; Workfile version not known yet. Determine that first. It
- ;; is either the head of the trunk, the head of the default
- ;; branch, or the "default branch" itself, if that is a full
- ;; revision number.
- (cond
- ;; no default branch
- ((or (not default-branch) (string= "" default-branch))
- (setq working-revision
- (vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1))
- (setq workfile-is-latest t))
- ;; default branch is actually a revision
- ((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$"
- default-branch)
- (setq working-revision default-branch))
- ;; else, search for the head of the default branch
- (t (vc-insert-file (vc-master-name file) "^desc")
+ (when (and (file-regular-p file) (vc-master-name file))
+ (with-temp-buffer
+ (if (or (not (vc-insert-file (vc-master-name file) "^[0-9]"))
+ (progn (goto-char (point-min))
+ (not (looking-at "^head[ \t\n]+[^;]+;$"))))
+ (error "File %s is not an RCS master file" (vc-master-name file)))
+ (let ((workfile-is-latest nil)
+ (default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1)))
+ (vc-file-setprop file 'vc-rcs-default-branch default-branch)
+ (unless working-revision
+ ;; Workfile version not known yet. Determine that first. It
+ ;; is either the head of the trunk, the head of the default
+ ;; branch, or the "default branch" itself, if that is a full
+ ;; revision number.
+ (cond
+ ;; no default branch
+ ((or (not default-branch) (string= "" default-branch))
(setq working-revision
- (vc-rcs-find-most-recent-rev default-branch))
- (setq workfile-is-latest t)))
- (vc-file-setprop file 'vc-working-revision working-revision))
- ;; Check strict locking
- (goto-char (point-min))
- (vc-file-setprop file 'vc-checkout-model
- (if (re-search-forward ";[ \t\n]*strict;" nil t)
- 'locking 'implicit))
- ;; Compute state of workfile version
- (goto-char (point-min))
- (let ((locking-user
- (vc-parse-buffer (concat "^locks[ \t\n]+[^;]*[ \t\n]+\\([^:]+\\):"
- (regexp-quote working-revision)
- "[^0-9.]")
- 1)))
- (cond
- ;; not locked
- ((not locking-user)
- (if (or workfile-is-latest
- (vc-rcs-latest-on-branch-p file working-revision))
- ;; workfile version is latest on branch
- 'up-to-date
- ;; workfile version is not latest on branch
- 'needs-update))
- ;; locked by the calling user
- ((and (stringp locking-user)
- (string= locking-user (vc-user-login-name file)))
- ;; Don't call `vc-rcs-checkout-model' to avoid inf-looping.
- (if (or (eq (vc-file-getprop file 'vc-checkout-model) 'locking)
- workfile-is-latest
- (vc-rcs-latest-on-branch-p file working-revision))
- 'edited
- ;; Locking is not used for the file, but the owner does
- ;; have a lock, and there is a higher version on the current
- ;; branch. Not sure if this can occur, and if it is right
- ;; to use `needs-merge' in this case.
- 'needs-merge))
- ;; locked by somebody else
- ((stringp locking-user)
- locking-user)
- (t
- (error "Error getting state of RCS file")))))))
+ (vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1))
+ (setq workfile-is-latest t))
+ ;; default branch is actually a revision
+ ((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$"
+ default-branch)
+ (setq working-revision default-branch))
+ ;; else, search for the head of the default branch
+ (t (vc-insert-file (vc-master-name file) "^desc")
+ (setq working-revision
+ (vc-rcs-find-most-recent-rev default-branch))
+ (setq workfile-is-latest t)))
+ (vc-file-setprop file 'vc-working-revision working-revision))
+ ;; Check strict locking
+ (goto-char (point-min))
+ (vc-file-setprop file 'vc-checkout-model
+ (if (re-search-forward ";[ \t\n]*strict;" nil t)
+ 'locking 'implicit))
+ ;; Compute state of workfile version
+ (goto-char (point-min))
+ (let ((locking-user
+ (vc-parse-buffer (concat "^locks[ \t\n]+[^;]*[ \t\n]+\\([^:]+\\):"
+ (regexp-quote working-revision)
+ "[^0-9.]")
+ 1)))
+ (cond
+ ;; not locked
+ ((not locking-user)
+ (if (or workfile-is-latest
+ (vc-rcs-latest-on-branch-p file working-revision))
+ ;; workfile version is latest on branch
+ 'up-to-date
+ ;; workfile version is not latest on branch
+ 'needs-update))
+ ;; locked by the calling user
+ ((and (stringp locking-user)
+ (string= locking-user (vc-user-login-name file)))
+ ;; Don't call `vc-rcs-checkout-model' to avoid inf-looping.
+ (if (or (eq (vc-file-getprop file 'vc-checkout-model) 'locking)
+ workfile-is-latest
+ (vc-rcs-latest-on-branch-p file working-revision))
+ 'edited
+ ;; Locking is not used for the file, but the owner does
+ ;; have a lock, and there is a higher version on the current
+ ;; branch. Not sure if this can occur, and if it is right
+ ;; to use `needs-merge' in this case.
+ 'needs-merge))
+ ;; locked by somebody else
+ ((stringp locking-user)
+ locking-user)
+ (t
+ (error "Error getting state of RCS file"))))))))
(defun vc-rcs-consult-headers (file)
"Search for RCS headers in FILE, and set properties accordingly.
(defun vc-sccs-working-revision (file)
"SCCS-specific version of `vc-working-revision'."
- (with-temp-buffer
- ;; The working revision is always the latest revision number.
- ;; To find this number, search the entire delta table,
- ;; rather than just the first entry, because the
- ;; first entry might be a deleted ("R") revision.
- (vc-insert-file (vc-master-name file) "^\001e\n\001[^s]")
- (vc-parse-buffer "^\001d D \\([^ ]+\\)" 1)))
+ (when (and (file-regular-p file) (vc-master-name file))
+ (with-temp-buffer
+ ;; The working revision is always the latest revision number.
+ ;; To find this number, search the entire delta table,
+ ;; rather than just the first entry, because the
+ ;; first entry might be a deleted ("R") revision.
+ (vc-insert-file (vc-master-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)
(defun vc-src-working-revision (file)
"SRC-specific version of `vc-working-revision'."
- (or (ignore-errors
- (with-output-to-string
- (vc-src-command standard-output file "list" "-f{1}" "@")))
- "0"))
+ (let ((result (ignore-errors
+ (with-output-to-string
+ (vc-src-command standard-output file "list" "-f{1}" "@")))))
+ (if (zerop (length result)) "0" result)))
;;;
;;; State-changing functions
:version "22.1"
:group 'vc-svn)
+(defcustom vc-svn-annotate-switches nil
+ "String or list of strings specifying switches for svn annotate under VC.
+If nil, use the value of `vc-annotate-switches'. If t, use no
+switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "25.1"
+ :group 'vc-svn)
+
(defcustom vc-svn-header '("\$Id\$")
"Header keywords to be inserted by `vc-insert-headers'."
:version "24.1" ; no longer consult the obsolete vc-header-alist
;; Support for `svn annotate'
(defun vc-svn-annotate-command (file buf &optional rev)
- (vc-svn-command buf 'async file "annotate" (if rev (concat "-r" rev))))
+ (apply #'vc-svn-command buf 'async file "annotate"
+ (append (vc-switches 'svn 'annotate)
+ (if rev (list (concat "-r" rev))))))
(defun vc-svn-annotate-time-of-rev (rev)
;; Arbitrarily assume 10 commits per day.
:group 'vc
:version "21.1")
+(defcustom vc-annotate-switches nil
+ "A string or list of strings specifying switches for annotate under VC.
+When running annotate under a given BACKEND, VC uses the first
+non-nil value of `vc-BACKEND-annotate-switches', `vc-annotate-switches',
+and `annotate-switches', in that order. Since nil means to check the
+next variable in the sequence, either of the first two may use
+the value t to mean no switches at all. `vc-annotate-switches'
+should contain switches that are specific to version control, but
+not specific to any particular backend.
+
+As very few switches (if any) are used across different VC tools,
+please consider using the specific `vc-BACKEND-annotate-switches'
+for the backend you use."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :group 'vc
+ :version "25.1")
+
(defcustom vc-log-show-limit 2000
"Limit the number of items shown by the VC log commands.
Zero means unlimited.
(vc-call-backend bk 'create-repo))
(throw 'found bk))))
+;;;###autoload
(defun vc-responsible-backend (file)
"Return the name of a backend system that is responsible for FILE.
;; Redefine the font selection to use the standard W32 dialog
(defcustom w32-use-w32-font-dialog t
- "Use the standard font dialog.
+ "If non-nil, use the standard Windows font dialog for font selection.
If nil, pop up a menu of a fixed set of fonts including fontsets, like
-X does. See `w32-fixed-font-alist' for the font menu definition."
+X does. See `w32-fixed-font-alist' for the fonts to appear in the menu.
+
+Setting this variable directly does not have any effect;
+use either \\[customize] or set `mouse-appearance-menu-map' to nil
+after changing the value of this variable."
:type 'boolean
+ :set (lambda (symbol value)
+ (set symbol value)
+ (setq mouse-appearance-menu-map nil))
:group 'w32)
(defvar w32-list-proportional-fonts nil
"-*-Lucida Sans Typewriter-semibold-r-*-*-16-*-*-*-c-*-iso8859-1"))
("Courier"
("Courier 10x8"
- "-*-Courier-*normal-r-*-*-*-97-*-*-c-80-iso8859-1")
+ "-*-Courier New-normal-r-*-*-*-97-*-*-c-80-iso8859-1")
("Courier 12x9"
- "-*-Courier-*normal-r-*-*-*-120-*-*-c-90-iso8859-1")
+ "-*-Courier New-normal-r-*-*-*-120-*-*-c-90-iso8859-1")
("Courier 15x12"
- "-*-Courier-*normal-r-*-*-*-150-*-*-c-120-iso8859-1")
+ "-*-Courier New-normal-r-*-*-*-150-*-*-c-120-iso8859-1")
;; For these, we specify the point height.
("")
("8" "-*-Courier New-normal-r-*-*-11-*-*-*-c-*-iso8859-1")
* (apply 'widget-create CLASS ARGS)
The third argument DOC is a documentation string for the widget."
+ ;;
+ (unless (or (null doc) (stringp doc))
+ (error "widget documentation must be `nil' or a string."))
(put name 'widget-type (cons class args))
(put name 'widget-documentation (purecopy doc))
name)
If no window is at direction DIR, an error is signaled."
(let ((other-window (windmove-find-other-window dir arg window)))
(cond ((null other-window)
- (error "No window %s from selected window" dir))
+ (user-error "No window %s from selected window" dir))
((and (window-minibuffer-p other-window)
(not (minibuffer-window-active-p other-window)))
- (error "Minibuffer is inactive"))
+ (user-error "Minibuffer is inactive"))
(t
(select-window other-window)))))
(insert
(format "frame pixel: %s x %s cols/lines: %s x %s units: %s x %s\n"
(frame-pixel-width frame) (frame-pixel-height frame)
- (frame-total-cols frame) (frame-text-lines frame) ; (frame-total-lines frame)
+ (frame-total-cols frame) (frame-total-lines frame)
(frame-char-width frame) (frame-char-height frame))
(format "frame text pixel: %s x %s cols/lines: %s x %s\n"
(frame-text-width frame) (frame-text-height frame)
(window-body-width window pixelwise)
(window-body-height window pixelwise)))
+(defun window-font-width (&optional window face)
+ "Return average character width for the font of FACE used in WINDOW.
+WINDOW must be a live window and defaults to the selected one.
+
+If FACE is nil or omitted, the default face is used. If FACE is
+remapped (see `face-remapping-alist'), the function returns the
+information for the remapped face."
+ (with-selected-window (window-normalize-window window t)
+ (if (display-multi-font-p)
+ (let* ((face (if face face 'default))
+ (info (font-info (face-font face)))
+ (width (aref info 11)))
+ (if (> width 0)
+ width
+ (aref info 10)))
+ (frame-char-width))))
+
+(defun window-font-height (&optional window face)
+ "Return character height for the font of FACE used in WINDOW.
+WINDOW must be a live window and defaults to the selected one.
+
+If FACE is nil or omitted, the default face is used. If FACE is
+remapped (see `face-remapping-alist'), the function returns the
+information for the remapped face."
+ (with-selected-window (window-normalize-window window t)
+ (if (display-multi-font-p)
+ (let* ((face (if face face 'default))
+ (info (font-info (face-font face))))
+ (aref info 3))
+ (frame-char-height))))
+
+(defun window-max-chars-per-line (&optional window face)
+ "Return the number of characters that can be displayed on one line in WINDOW.
+WINDOW must be a live window and defaults to the selected one.
+
+The character width of FACE is used for the calculation. If FACE
+is nil or omitted, the default face is used. If FACE is
+remapped (see `face-remapping-alist'), the function uses the
+remapped face.
+
+This function is different from `window-body-width' in two
+ways. First, it accounts for the portions of the line reserved
+for the continuation glyph. Second, it accounts for the size of
+the font."
+ (with-selected-window (window-normalize-window window t)
+ (let* ((window-width (window-body-width window t))
+ (font-width (window-font-width window face))
+ (ncols (/ window-width font-width)))
+ (if (and (display-graphic-p)
+ overflow-newline-into-fringe
+ (/= (frame-parameter nil 'left-fringe) 0)
+ (/= (frame-parameter nil 'right-fringe) 0))
+ ncols
+ (1- ncols)))))
+
(defun window-current-scroll-bars (&optional window)
"Return the current scroll bar types for WINDOW.
WINDOW must be a live window and defaults to the selected one.
(window-buffer window))))
(if (integerp t-p-w-w)
(< (window-width window) t-p-w-w)
- t-p-w-w))))
+ t-p-w-w))))
+
+\f
+;; Automatically inform subprocesses of changes to window size.
+
+(defcustom window-adjust-process-window-size-function
+ 'window-adjust-process-window-size-smallest
+ "Control how Emacs chooses inferior process window sizes.
+Emacs uses this function to tell processes the space they have
+available for displaying their output. After each window
+configuration change, Emacs calls the value of
+`window-adjust-process-window-size-function' for each process
+with a buffer being displayed in at least one window.
+This function is responsible for combining the sizes of the
+displayed windows and returning a cons (WIDTH . HEIGHT)
+describing the width and height with which Emacs will call
+`set-process-window-size' for that process. If the function
+returns `nil', Emacs does not call `set-process-window-size'.
+
+This function is called with the process buffer as the current
+buffer and with two arguments: the process and a list of windows
+displaying process. Modes can make this variable buffer-local;
+additionally, the `adjust-window-size-function' process property
+overrides the global or buffer-local value of
+`window-adjust-process-window-size-function'."
+ :type '(choice
+ (const :tag "Minimum area of any window"
+ window-adjust-process-window-size-smallest)
+ (const :tag "Maximum area of any window"
+ window-adjust-process-window-size-largest)
+ (const :tag "Do not adjust process window sizes" ignore)
+ function)
+ :group 'windows
+ :version "25.1")
+
+(defun window-adjust-process-window-size (reducer process windows)
+ "Adjust the process window size of PROCESS.
+WINDOWS is a list of windows associated with PROCESS. REDUCER is
+a two-argument function used to combine the widths and heights of
+the given windows."
+ (when windows
+ (let ((width (window-body-width (car windows)))
+ (height (window-body-height (car windows))))
+ (dolist (window (cdr windows))
+ (setf width (funcall reducer width (window-body-width window)))
+ (setf height (funcall reducer height (window-body-height window))))
+ (cons width height))))
+
+(defun window-adjust-process-window-size-smallest (process windows)
+ "Adjust the process window size of PROCESS.
+WINDOWS is a list of windows associated with PROCESS. Choose the
+smallest area available for displaying PROCESS's output."
+ (window-adjust-process-window-size #'min process windows))
+
+(defun window-adjust-process-window-size-largest (process windows)
+ "Adjust the process window size of PROCESS.
+WINDOWS is a list of windows associated with PROCESS. Choose the
+largest area available for displaying PROCESS's output."
+ (window-adjust-process-window-size #'max process windows))
+
+(defun window--process-window-list ()
+ "Return an alist mapping processes to associated windows.
+A window is associated with a process if that window is
+displaying that processes's buffer."
+ (let ((processes (process-list))
+ (process-windows nil))
+ (walk-windows
+ (lambda (window)
+ (let ((buffer (window-buffer window))
+ (iter processes))
+ (while (let ((process (car iter)))
+ (if (and (process-live-p process)
+ (eq buffer (process-buffer process)))
+ (let ((procwin (assq process process-windows)))
+ ;; Add this window to the list of windows
+ ;; displaying process.
+ (if procwin
+ (push window (cdr procwin))
+ (push (list process window) process-windows))
+ ;; We found our process for this window, so
+ ;; stop iterating over the process list.
+ nil)
+ (setf iter (cdr iter)))))))
+ 1 t)
+ process-windows))
+
+(defun window--adjust-process-windows ()
+ "Update process window sizes to match the current window configuration."
+ (dolist (procwin (window--process-window-list))
+ (let ((process (car procwin)))
+ (with-demoted-errors "Error adjusting window size: %S"
+ (with-current-buffer (process-buffer process)
+ (let ((size (funcall
+ (or (process-get process 'adjust-window-size-function)
+ window-adjust-process-window-size-function)
+ process (cdr procwin))))
+ (when size
+ (set-process-window-size process (cdr size) (car size)))))))))
+
+(add-hook 'window-configuration-change-hook 'window--adjust-process-windows)
+
\f
;; Some of these are in tutorial--default-keys, so update that if you
;; change these.
(ring-ref winner-pending-undo-ring 0)))
(unless (eq (selected-window) (minibuffer-window))
(message "Winner undid undo")))
- (t (error "Previous command was not a `winner-undo'"))))
+ (t (user-error "Previous command was not a `winner-undo'"))))
(provide 'winner)
;;; winner.el ends here
DATA is the moz-url, which is formatted as two strings separated by \\r\\n.
The first string is the URL, the second string is the title of that URL.
DATA is encoded in utf-16. Decode the URL and call `x-dnd-handle-uri-list'."
- ;; Mozilla and applications based on it (Galeon for example) uses
- ;; text/unicode, but it is impossible to tell if it is le or be. Use what
- ;; the machine Emacs runs on use. This loses if dropping between machines
- ;; with different endian, but it is the best we can do.
+ ;; Mozilla and applications based on it use text/unicode, but it is
+ ;; impossible to tell if it is le or be. Use what the machine Emacs
+ ;; runs on uses. This loses if dropping between machines
+ ;; with different endian-ness, but it is the best we can do.
(let* ((coding (if (eq (byteorder) ?B) 'utf-16be 'utf-16le))
(string (decode-coding-string data coding))
(strings (split-string string "[\r\n]" t))
(ev-data (nth 1 event))
(ev-where (nth 1 ev-data))
(vec (vector event))
+ (is-move (eq 'mouse-movement ev-command))
(is-down (string-match "down-" (symbol-name ev-command))))
;; Mouse events symbols must have an 'event-kind property with
(is-down
(setf (terminal-parameter nil 'xterm-mouse-last-down) event)
vec)
+ (is-move vec)
(t
(let* ((down (terminal-parameter nil 'xterm-mouse-last-down))
(down-data (nth 1 down))
(fdiff (- f (* 1.0 maxwrap dbig))))
(+ (truncate fdiff) (* maxwrap dbig))))))
-;; 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 ()
- (let* ((code (- (read-event) 32))
- (type
- ;; 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))
- (format "M-down-mouse-%d" (- code 7)))
- ((memq code '(3 11))
- (let ((down (car (terminal-parameter
- nil 'xterm-mouse-last-down))))
- (when (and down (string-match "[0-9]" (symbol-name down)))
- (format (if (eq code 3) "mouse-%s" "M-mouse-%s")
- (match-string 0 (symbol-name down))))))
- ((memq code '(0 1 2))
- (format "down-mouse-%d" (+ 1 code)))))
- (x (- (read-event) 33))
- (y (- (read-event) 33)))
- (and type (wholenump x) (wholenump y)
- (list (intern type) x y))))
-
-;; 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 (read-event)) ?\;))
- (push c button-bytes))
- (while (not (eq (setq c (read-event)) ?\;))
- (push c x-bytes))
- (while (not (memq (setq c (read-event)) '(?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+ (mod code 4))))))
- (1- (string-to-number (apply 'string (nreverse x-bytes))))
- (1- (string-to-number (apply 'string (nreverse y-bytes)))))))
+(defun xterm-mouse--read-utf8-char (&optional prompt seconds)
+ "Read an utf-8 encoded character from the current terminal.
+This function reads and returns an utf-8 encoded character of
+command input. If the user generates an event which is not a
+character (i.e., a mouse click or function key event), read-char
+signals an error.
+
+The returned event may come directly from the user, or from a
+keyboard macro. It is not decoded by the keyboard's input coding
+system and always treated with an utf-8 input encoding.
+
+The optional arguments PROMPT and SECONDS work like in
+`read-event'."
+ (let ((tmp (keyboard-coding-system)))
+ (set-keyboard-coding-system 'utf-8)
+ (prog1 (read-event prompt t seconds)
+ (set-keyboard-coding-system tmp))))
+
+;; In default mode, each numeric parameter of XTerm's mouse report is
+;; a single char, possibly encoded as utf-8. The actual numeric
+;; parameter then is obtained by subtracting 32 from the character
+;; code. In extended mode the parameters are returned as decimal
+;; string delimited either by semicolons or for the last parameter by
+;; one of the characters "m" or "M". If the last character is a "m",
+;; then the mouse event was a button release, else it was a button
+;; press or a mouse motion. Return value is a cons cell with
+;; (NEXT-NUMERIC-PARAMETER . LAST-CHAR)
+(defun xterm-mouse--read-number-from-terminal (extension)
+ (let (c)
+ (if extension
+ (let ((n 0))
+ (while (progn
+ (setq c (read-char))
+ (<= ?0 c ?9))
+ (setq n (+ (* 10 n) c (- ?0))))
+ (cons n c))
+ (cons (- (setq c (xterm-mouse--read-utf8-char)) 32) c))))
+
+;; XTerm reports mouse events as
+;; <EVENT-CODE> <X> <Y> in default mode, and
+;; <EVENT-CODE> ";" <X> ";" <Y> <"M" or "m"> in extended mode.
+;; The macro read-number-from-terminal takes care of reading
+;; the response parameters appropriately. The EVENT-CODE differs
+;; slightly between default and extended mode.
+;; Return a list (EVENT-TYPE-SYMBOL X Y).
+(defun xterm-mouse--read-event-sequence (&optional extension)
+ (pcase-let*
+ ((`(,code . ,_) (xterm-mouse--read-number-from-terminal extension))
+ (`(,x . ,_) (xterm-mouse--read-number-from-terminal extension))
+ (`(,y . ,c) (xterm-mouse--read-number-from-terminal extension))
+ (wheel (/= (logand code 64) 0))
+ (move (/= (logand code 32) 0))
+ (ctrl (/= (logand code 16) 0))
+ (meta (/= (logand code 8) 0))
+ (shift (/= (logand code 4) 0))
+ (down (and (not wheel)
+ (not move)
+ (if extension
+ (eq c ?M)
+ (/= (logand code 3) 3))))
+ (btn (cond
+ ((or extension down wheel)
+ (+ (logand code 3) (if wheel 4 1)))
+ ;; The default mouse protocol does not report the button
+ ;; number in release events: extract the button number
+ ;; from last button-down event.
+ ((terminal-parameter nil 'xterm-mouse-last-down)
+ (string-to-number
+ (substring
+ (symbol-name
+ (car (terminal-parameter nil 'xterm-mouse-last-down)))
+ -1)))
+ ;; Spurious release event without previous button-down
+ ;; event: assume, that the last button was button 1.
+ (t 1)))
+ (sym (if move 'mouse-movement
+ (intern (concat (if ctrl "C-" "")
+ (if meta "M-" "")
+ (if shift "S-" "")
+ (if down "down-" "")
+ "mouse-"
+ (number-to-string btn))))))
+ (list sym (1- x) (1- y))))
(defun xterm-mouse--set-click-count (event click-count)
(setcdr (cdr event) (list click-count))
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")))))
+ (let ((click (cond ((memq extension '(1006 nil))
+ (xterm-mouse--read-event-sequence extension))
+ (t
+ (error "Unsupported XTerm mouse protocol")))))
(when click
(let* ((type (nth 0 click))
(x (nth 1 click))
(setq mouse-position-function nil)))
(defconst xterm-mouse-tracking-enable-sequence
- "\e[?1000h\e[?1006h"
+ "\e[?1000h\e[?1002h\e[?1005h\e[?1006h"
"Control sequence to enable xterm mouse tracking.
-Enables basic tracking, then extended tracking on
-terminals that support it.")
+Enables basic mouse tracking, mouse motion events and finally
+extended tracking on terminals that support it. The following
+escape sequences are understood by modern xterms:
+
+\"\\e[?1000h\" `Basic mouse mode´: Enables reports for mouse
+ clicks. There is a limit to the maximum row/column
+ position (<= 223), which can be reported in this
+ basic mode.
+
+\"\\e[?1002h\" `Mouse motion mode´: Enables reports for mouse
+ motion events during dragging operations.
+
+\"\\e[?1005h\" `UTF-8 coordinate extension`: Enables an extension
+ to the basic mouse mode, which uses UTF-8
+ characters to overcome the 223 row/column limit. This
+ extension may conflict with non UTF-8 applications or
+ non UTF-8 locales.
+
+\"\\e[?1006h\" `SGR coordinate extension´: Enables a newer
+ alternative extension to the basic mouse mode, which
+ overcomes the 223 row/column limit without the
+ drawbacks of the UTF-8 coordinate extension.
+
+The two extension modes are mutually exclusive, where the last
+given escape sequence takes precedence over the former.")
(defconst xterm-mouse-tracking-disable-sequence
- "\e[?1006l\e[?1000l"
+ "\e[?1006l\e[?1005l\e[?1002l\e[?1000l"
"Reset the modes set by `xterm-mouse-tracking-enable-sequence'.")
(defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal)
+++ /dev/null
-;;; xwidget.el --- api functions for xwidgets -*- lexical-binding: t -*-
-;; see xwidget.c for more api functions
-
-
-;;; Commentary:
-;;
-
-;;TODO this breaks compilation when we dont have xwidgets
-;;(require 'xwidget-internal)
-
-;;TODO model after make-text-button instead!
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'reporter)
-(require 'bookmark)
-
-(defcustom xwidget-webkit-scroll-behaviour 'native
- "Scroll behaviour of the webkit instance.
-'native or 'image."
- :group 'xwidgets)
-
-(defun xwidget-insert (pos type title width height)
- "Insert an xwidget at POS.
-given ID, TYPE, TITLE WIDTH and
-HEIGHT in the current buffer.
-
-Return ID
-
-see `make-xwidget' for types suitable for TYPE."
- (goto-char pos)
- (let ((id (make-xwidget (point) (point)
- type title width height nil)))
- (put-text-property (point) (+ 1 (point))
- 'display (list 'xwidget ':xwidget id))
- id))
-
-(defun xwidget-at (pos)
- "Return xwidget at POS."
- ;;TODO this function is a bit tedious because the C layer isnt well protected yet and
- ;;xwidgetp aparently doesnt work yet
- (let* ((disp (get-text-property pos 'display))
- (xw (car (cdr (cdr disp)))))
- ;;(if ( xwidgetp xw) xw nil)
- (if (equal 'xwidget (car disp)) xw)))
-
-
-;; (defun xwidget-socket-handler ()
-;; "Create plug for socket. TODO."
-;; (interactive)
-;; (message "socket handler xwidget %S" last-input-event)
-;; (let*
-;; ((xwidget-event-type (nth 2 last-input-event))
-;; (xwidget-id (nth 1 last-input-event)))
-;; (cond ( (eq xwidget-event-type 'xembed-ready)
-;; (let*
-;; ((xembed-id (nth 3 last-input-event)))
-;; (message "xembed ready event: %S xw-id:%s" xembed-id xwidget-id)
-;; ;;TODO fetch process data from the xwidget. create it, store process info
-;; ;;will start emacs/uzbl in a xembed socket when its ready
-;; ;; (cond
-;; ;; ((eq 3 xwidget-id)
-;; ;; (start-process "xembed" "*xembed*" (format "%ssrc/emacs" default-directory) "-q" "--parent-id" (number-to-string xembed-id) ) )
-;; ;; ((eq 5 xwidget-id)
-;; ;; (start-process "xembed2" "*xembed2*" "uzbl-core" "-s" (number-to-string xembed-id) "http://www.fsf.org" ) )
-;; )))))
-
-(defun xwidget-display (xwidget)
- "Force XWIDGET to be displayed to create a xwidget_view.
-Return the window displaying XWIDGET."
- (let* ((buffer (xwidget-buffer xwidget))
- (window (display-buffer buffer))
- (frame (window-frame window)))
- (set-frame-visible frame t)
- (redisplay t)
- window))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; webkit support
-(require 'browse-url)
-(require 'image-mode);;for some image-mode alike functionality
-(require 'cl-macs);;for flet
-
-;;;###autoload
-(defun xwidget-webkit-browse-url (url &optional new-session)
- "Ask xwidget-webkit to browse URL.
-NEW-SESSION specifies whether to create a new xwidget-webkit session. URL
-defaults to the string looking like a url around the cursor position."
- (interactive (progn
- (require 'browse-url)
- (browse-url-interactive-arg "xwidget-webkit URL: "
- ;;( xwidget-webkit-current-url)
- )))
- (when (stringp url)
- (setq url (url-tidy url))
- (if new-session
- (xwidget-webkit-new-session url)
- (xwidget-webkit-goto-url url))))
-
-
-;;shims for adapting image mode code to the webkit browser window
-(defun xwidget-image-display-size (spec &optional pixels frame)
- "Image code adaptor. SPEC PIXELS FRAME like the corresponding `image-mode' fn."
- (let ((xwi (xwidget-info (xwidget-at 1))))
- (cons (aref xwi 2)
- (aref xwi 3))))
-
-(defadvice image-display-size (around image-display-size-for-xwidget
- (spec &optional pixels frame)
- activate)
- "Advice for re-using image mode for xwidget."
- (if (eq (car spec) 'xwidget)
- (setq ad-return-value (xwidget-image-display-size spec pixels frame))
- ad-do-it))
-
-;;todo.
-;; - check that the webkit support is compiled in
-(defvar xwidget-webkit-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "g" 'xwidget-webkit-browse-url)
- (define-key map "a" 'xwidget-webkit-adjust-size-dispatch)
- (define-key map "b" 'xwidget-webkit-back )
- (define-key map "r" 'xwidget-webkit-reload )
- (define-key map "t" (lambda () (interactive) (message "o")) )
- (define-key map "\C-m" 'xwidget-webkit-insert-string)
- (define-key map "w" 'xwidget-webkit-current-url)
-
- ;;similar to image mode bindings
- (define-key map (kbd "SPC") 'xwidget-webkit-scroll-up)
- (define-key map (kbd "DEL") 'xwidget-webkit-scroll-down)
-
- (define-key map [remap scroll-up] 'xwidget-webkit-scroll-up)
- (define-key map [remap scroll-up-command] 'xwidget-webkit-scroll-up)
-
- (define-key map [remap scroll-down] 'xwidget-webkit-scroll-down)
- (define-key map [remap scroll-down-command] 'xwidget-webkit-scroll-down)
-
- (define-key map [remap forward-char] 'xwidget-webkit-scroll-forward)
- (define-key map [remap backward-char] 'xwidget-webkit-scroll-backward)
- (define-key map [remap right-char] 'xwidget-webkit-scroll-forward)
- (define-key map [remap left-char] 'xwidget-webkit-scroll-backward)
- ;; (define-key map [remap previous-line] 'image-previous-line)
- ;; (define-key map [remap next-line] 'image-next-line)
-
- ;; (define-key map [remap move-beginning-of-line] 'image-bol)
- ;; (define-key map [remap move-end-of-line] 'image-eol)
- ;; (define-key map [remap beginning-of-buffer] 'image-bob)
- ;; (define-key map [remap end-of-buffer] 'image-eob)
- map)
- "Keymap for `xwidget-webkit-mode'.")
-
-(defun xwidget-webkit-scroll-up ()
- "Scroll webkit up,either native or like image mode."
- (interactive)
- (if (eq xwidget-webkit-scroll-behaviour 'native)
- (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t 50)
- (image-scroll-up)))
-
-(defun xwidget-webkit-scroll-down ()
- "Scroll webkit down,either native or like image mode."
- (interactive)
- (if (eq xwidget-webkit-scroll-behaviour 'native)
- (xwidget-set-adjustment (xwidget-webkit-last-session) 'vertical t -50)
- (image-scroll-down)))
-
-(defun xwidget-webkit-scroll-forward ()
- "Scroll webkit forward,either native or like image mode."
- (interactive)
- (if (eq xwidget-webkit-scroll-behaviour 'native)
- (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t 50)
- (xwidget-webkit-scroll-forward)))
-
-(defun xwidget-webkit-scroll-backward ()
- "Scroll webkit backward,either native or like image mode."
- (interactive)
- (if (eq xwidget-webkit-scroll-behaviour 'native)
- (xwidget-set-adjustment (xwidget-webkit-last-session) 'horizontal t -50)
- (xwidget-webkit-scroll-backward)))
-
-
-;;the xwidget event needs to go into a higher level handler
-;;since the xwidget can generate an event even if its offscreen
-;;TODO this needs to use callbacks and consider different xw ev types
-(define-key (current-global-map) [xwidget-event] 'xwidget-event-handler)
-(defun xwidget-log ( &rest msg)
- "Log MSG to a buffer."
- (let ( (buf (get-buffer-create "*xwidget-log*")))
- (save-excursion
- (buffer-disable-undo buf)
- (set-buffer buf)
- (insert (apply 'format msg))
- (insert "\n"))))
-
-(defun xwidget-event-handler ()
- "Receive xwidget event."
- (interactive)
- (xwidget-log "stuff happened to xwidget %S" last-input-event)
- (let*
- ((xwidget-event-type (nth 1 last-input-event))
- (xwidget (nth 2 last-input-event))
- ;(xwidget-callback (xwidget-get xwidget 'callback));;TODO stopped working for some reason
- )
- ;(funcall xwidget-callback xwidget xwidget-event-type)
- (message "xw callback %s" xwidget)
- (funcall 'xwidget-webkit-callback xwidget xwidget-event-type)))
-
-(defun xwidget-webkit-callback (xwidget xwidget-event-type)
- "Callback for xwidgets.
-XWIDGET instance, XWIDGET-EVENT-TYPE depends on the originating xwidget."
- (save-excursion
- (cond ((buffer-live-p (xwidget-buffer xwidget))
- (set-buffer (xwidget-buffer xwidget))
- (let* ((strarg (nth 3 last-input-event)))
- (cond ((eq xwidget-event-type 'document-load-finished)
- (xwidget-log "webkit finished loading: '%s'" (xwidget-webkit-get-title xwidget))
- ;;TODO - check the native/internal scroll
- ;;(xwidget-adjust-size-to-content xwidget)
- (xwidget-webkit-adjust-size-dispatch) ;;TODO send xwidget here
- (rename-buffer (format "*xwidget webkit: %s *" (xwidget-webkit-get-title xwidget)))
- (pop-to-buffer (current-buffer)))
- ((eq xwidget-event-type 'navigation-policy-decision-requested)
- (if (string-match ".*#\\(.*\\)" strarg)
- (xwidget-webkit-show-id-or-named-element xwidget (match-string 1 strarg))))
- (t (xwidget-log "unhandled event:%s" xwidget-event-type)))))
- (t (xwidget-log "error: callback called for xwidget with dead buffer")))))
-
-(defvar bookmark-make-record-function)
-(define-derived-mode xwidget-webkit-mode
- special-mode "xwidget-webkit" "xwidget webkit view mode"
- (setq buffer-read-only t)
- (setq-local bookmark-make-record-function
- #'xwidget-webkit-bookmark-make-record)
- ;; Keep track of [vh]scroll when switching buffers
- (image-mode-setup-winprops))
-
-(defun xwidget-webkit-bookmark-make-record ()
- (nconc (bookmark-make-record-default t t)
- `((page . ,(xwidget-webkit-current-url))
- (handler . (lambda (bmk) (browse-url (bookmark-prop-get bmk 'page)))))))
-
-
-(defvar xwidget-webkit-last-session-buffer nil)
-
-(defun xwidget-webkit-last-session ()
- "Last active webkit, or nil."
- (if (buffer-live-p xwidget-webkit-last-session-buffer)
- (with-current-buffer xwidget-webkit-last-session-buffer
- (xwidget-at 1))
- nil))
-
-(defun xwidget-webkit-current-session ()
- "Either the webkit in the current buffer, or the last one used, which might be nil."
- (if (xwidget-at 1)
- (xwidget-at 1)
- (xwidget-webkit-last-session)))
-
-(defun xwidget-adjust-size-to-content (xw)
- "Resize XW to content."
- ;;xwidgets doesnt support widgets that have their own opinions about size well yet
- ;;this reads the desired size and resizes the emacs allocated area accordingly
- (let ((size (xwidget-size-request xw)))
- (xwidget-resize xw (car size) (cadr size))))
-
-
-(defvar xwidget-webkit-activeelement-js"
-function findactiveelement(doc){
-//alert(doc.activeElement.value);
- if(doc.activeElement.value != undefined){
- return doc.activeElement;
- }else{
- // recurse over the child documents:
- var frames = doc.getElementsByTagName('frame');
- for (var i = 0; i < frames.length; i++)
- {
- var d = frames[i].contentDocument;
- var rv = findactiveelement(d);
- if(rv != undefined){
- return rv;
- }
- }
- }
- return undefined;
-};
-
-
-"
-
- "javascript that finds the active element."
- ;;yes its ugly. because:
- ;; - there is aparently no way to find the active frame other than recursion
- ;; - the js "for each" construct missbehaved on the "frames" collection
- ;; - a window with no frameset still has frames.length == 1, but frames[0].document.activeElement != document.activeElement
- ;;TODO the activeelement type needs to be examined, for iframe, etc. sucks.
- )
-
-(defun xwidget-webkit-insert-string (xw str)
- "Insert string in the active field in the webkit.
-Argument XW webkit.
-Argument STR string."
- ;;read out the string in the field first and provide for edit
- (interactive
- (let* ((xww (xwidget-webkit-current-session))
-
- (field-value
- (progn
- (xwidget-webkit-execute-script xww xwidget-webkit-activeelement-js)
- (xwidget-webkit-execute-script-rv xww "findactiveelement(document).value;" )))
- (field-type (xwidget-webkit-execute-script-rv xww "findactiveelement(document).type;" )))
- (list xww
- (cond ((equal "text" field-type)
- (read-string "text:" field-value))
- ((equal "password" field-type)
- (read-passwd "password:" nil field-value))
- ((equal "textarea" field-type)
- (xwidget-webkit-begin-edit-textarea xww field-value))))))
- (xwidget-webkit-execute-script xw (format "findactiveelement(document).value='%s'" str)))
-
-(defvar xwidget-xwbl)
-(defun xwidget-webkit-begin-edit-textarea (xw text)
- "Start editing of a webkit text area.
-XW is the xwidget identifier, TEXT is retrieved from the webkit."
- (switch-to-buffer
- (generate-new-buffer "textarea"))
-
- (set (make-local-variable 'xwidget-xwbl) xw)
- (insert text))
-
-(defun xwidget-webkit-end-edit-textarea ()
- "End editing of a webkit text area."
- (interactive)
- (goto-char (point-min))
- (while (search-forward "\n" nil t)
- (replace-match "\\n" nil t))
- (xwidget-webkit-execute-script xwidget-xwbl (format "findactiveelement(document).value='%s'"
- (buffer-substring (point-min) (point-max))))
- ;;TODO convert linefeed to \n
- )
-
-(defun xwidget-webkit-show-named-element (xw element-name)
- "Make named-element show. for instance an anchor."
- (interactive (list (xwidget-webkit-current-session) (read-string "element name:")))
- ;;TODO
- ;; since an xwidget is an Emacs object, it is not trivial to do some things that are taken for granted in a normal browser.
- ;; scrolling an anchor/named-element into view is one such thing.
- ;; this function implements a proof-of-concept for this.
- ;; problems remaining:
- ;; - the selected window is scrolled but this is not always correct
- ;; - this needs to be interfaced into browse-url somehow. the tricky part is that we need to do this in two steps:
- ;; A: load the base url, wait for load signal to arrive B: navigate to the anchor when the base url is finished rendering
-
- ;;this part figures out the Y coordinate of the element
- (let ((y (string-to-number
- (xwidget-webkit-execute-script-rv xw
- (format "document.getElementsByName('%s')[0].getBoundingClientRect().top" element-name)
- 0))))
- ;;now we need to tell emacs to scroll the element into view.
- (xwidget-log "scroll: %d" y)
- (set-window-vscroll (selected-window) y t)))
-
-(defun xwidget-webkit-show-id-element (xw element-id)
- "make id-element show. for instance an anchor."
- (interactive (list (xwidget-webkit-current-session)
- (read-string "element id:")))
- (let ((y (string-to-number
- (xwidget-webkit-execute-script-rv xw
- (format "document.getElementById('%s').getBoundingClientRect().top" element-id)
- 0))))
- ;;now we need to tell emacs to scroll the element into view.
- (xwidget-log "scroll: %d" y)
- (set-window-vscroll (selected-window) y t)))
-
-(defun xwidget-webkit-show-id-or-named-element (xw element-id)
- "make id-element show. for instance an anchor."
- (interactive (list (xwidget-webkit-current-session)
- (read-string "element id:")))
- (let* ((y1 (string-to-number
- (xwidget-webkit-execute-script-rv xw
- (format "document.getElementsByName('%s')[0].getBoundingClientRect().top" element-id)
- "0")))
- (y2 (string-to-number
- (xwidget-webkit-execute-script-rv xw
- (format "document.getElementById('%s').getBoundingClientRect().top" element-id)
- "0")))
- (y3 (max y1 y2)))
- ;;now we need to tell emacs to scroll the element into view.
- (xwidget-log "scroll: %d" y3)
- (set-window-vscroll (selected-window) y3 t)))
-
-(defun xwidget-webkit-adjust-size-to-content ()
- "Adjust webkit to content size."
- (interactive)
- (xwidget-adjust-size-to-content (xwidget-webkit-current-session)))
-
-(defun xwidget-webkit-adjust-size-dispatch ()
- "Adjust size according to mode."
- (interactive)
- (if (eq xwidget-webkit-scroll-behaviour 'native)
- (xwidget-webkit-adjust-size-to-window)
- (xwidget-webkit-adjust-size-to-content))
- ;;the recenter is intended to correct a visual glitch
- ;;it errors out if the buffer isnt visible, but then we dont get the glitch,
- ;;so silence errors
- (ignore-errors
- (recenter-top-bottom))
- )
-
-(defun xwidget-webkit-adjust-size-to-window ()
- "Adjust webkit to window."
- (interactive)
- (xwidget-resize ( xwidget-webkit-current-session) (window-pixel-width) (window-pixel-height)))
-
-(defun xwidget-webkit-adjust-size (w h)
- "Manualy set webkit size.
-Argument W width.
-Argument H height."
- ;;TODO shouldnt be tied to the webkit xwidget
- (interactive "nWidth:\nnHeight:\n")
- (xwidget-resize ( xwidget-webkit-current-session) w h))
-
-(defun xwidget-webkit-fit-width ()
- "Adjust width of webkit to window width."
- (interactive)
- (xwidget-webkit-adjust-size (- (caddr (window-inside-pixel-edges))
- (car (window-inside-pixel-edges)))
- 1000))
-
-(defun xwidget-webkit-new-session (url)
- "Create a new webkit session buffer with URL."
- (let*
- ((bufname (generate-new-buffer-name "*xwidget-webkit*"))
- xw)
- (setq xwidget-webkit-last-session-buffer (switch-to-buffer (get-buffer-create bufname)))
- (insert " 'a' adjusts the xwidget size.")
- (setq xw (xwidget-insert 1 'webkit-osr bufname 1000 1000))
- (xwidget-put xw 'callback 'xwidget-webkit-callback)
- (xwidget-webkit-mode)
- (xwidget-webkit-goto-uri (xwidget-webkit-last-session) url )))
-
-
-(defun xwidget-webkit-goto-url (url)
- "Goto URL."
- (if (xwidget-webkit-current-session)
- (progn
- (xwidget-webkit-goto-uri (xwidget-webkit-current-session) url))
- (xwidget-webkit-new-session url)))
-
-(defun xwidget-webkit-back ()
- "Back in history."
- (interactive)
- (xwidget-webkit-execute-script (xwidget-webkit-current-session) "history.go(-1);"))
-
-(defun xwidget-webkit-reload ()
- "Reload current url."
- (interactive)
- (xwidget-webkit-execute-script (xwidget-webkit-current-session) "history.go(0);"))
-
-(defun xwidget-webkit-current-url ()
- "Get the webkit url. place it on kill ring."
- (interactive)
- (let* ((rv (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session)
- "document.URL"))
- (url (kill-new (or rv ""))))
- (message "url: %s" url )
- url))
-
-(defun xwidget-webkit-execute-script-rv (xw script &optional default)
- "Same as 'xwidget-webkit-execute-script' but but with return value.
-XW is the webkit instance. SCRIPT is the script to execut.
-DEFAULT is the defaultreturn value."
- ;;notice the fugly "title" hack. it is needed because the webkit api
- ;;doesnt support returning values. this is a wrapper for the title
- ;;hack so its easy to remove should webkit someday support JS return
- ;;values or we find some other way to access the DOM
-
- ;;reset webkit title. fugly.
- (let* ((emptytag "titlecantbewhitespaceohthehorror")
- title)
- (xwidget-webkit-execute-script xw (format "document.title=\"%s\";" (or default emptytag)))
- (xwidget-webkit-execute-script xw (format "document.title=%s;" script))
- (setq title (xwidget-webkit-get-title xw))
- (if (equal emptytag title)
- (setq title ""))
- (unless title
- (setq title default))
- title))
-
-
-;; use declare here?
-;; (declare-function xwidget-resize-internal "xwidget.c" )
-;; check-declare-function?
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun xwidget-webkit-get-selection ()
- "Get the webkit selection."
- (xwidget-webkit-execute-script-rv (xwidget-webkit-current-session)
- "window.getSelection().toString();"))
-
-(defun xwidget-webkit-copy-selection-as-kill ()
- "Get the webkit selection and put it on the kill ring."
- (interactive)
- (kill-new (xwidget-webkit-get-selection)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; xwidget plist management(similar to the process plist functions)
-
-(defun xwidget-get (xwidget propname)
- "Return the value of XWIDGET' PROPNAME property.
-This is the last value stored with `(xwidget-put XWIDGET PROPNAME VALUE)'."
- (plist-get (xwidget-plist xwidget) propname))
-
-(defun xwidget-put (xwidget propname value)
- "Change XWIDGET' PROPNAME property to VALUE.
-It can be retrieved with `(xwidget-get XWIDGET PROPNAME)'."
- (set-xwidget-plist xwidget
- (plist-put (xwidget-plist xwidget) propname value)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun xwidget-delete-zombies ()
- "Helper for xwidget-cleanup."
- (dolist (xwidget-view xwidget-view-list)
- (when (or (not (window-live-p (xwidget-view-window xwidget-view)))
- (not (memq (xwidget-view-model xwidget-view)
- xwidget-list)))
- (delete-xwidget-view xwidget-view))))
-
-(defun xwidget-cleanup ()
- "Delete zombie xwidgets."
- ;;its still pretty easy to trigger bugs with xwidgets.
- ;;this function tries to implement a workaround
- (interactive)
- ;; kill xviews who should have been deleted but stull linger
- (xwidget-delete-zombies)
- ;; redraw display otherwise ghost of zombies will remain to haunt the screen
- (redraw-display))
-
-;;this is a workaround because I cant find the right place to put it in C
-;;seems to work well in practice though
-;;(add-hook 'window-configuration-change-hook 'xwidget-cleanup)
-(add-hook 'window-configuration-change-hook 'xwidget-delete-zombies)
-
-(defun xwidget-kill-buffer-query-function ()
- "Ask beforek illing a buffer that has xwidgets."
- (let ((xwidgets (get-buffer-xwidgets (current-buffer))))
- (or (not xwidgets)
- (not (memq t (mapcar 'xwidget-query-on-exit-flag xwidgets)))
- (yes-or-no-p
- (format "Buffer %S has xwidgets; kill it? "
- (buffer-name (current-buffer)))))))
-
-(add-hook 'kill-buffer-query-functions 'xwidget-kill-buffer-query-function)
-
-;;killflash is sadly not reliable yet.
-(defvar xwidget-webkit-kill-flash-oneshot t)
-(defun xwidget-webkit-kill-flash ()
- "Disable the flash plugin in webkit.
-This is needed because Flash is non-free and doesnt work reliably
-on 64 bit systems and offscreen rendering. Sadly not reliable
-yet, so deinstall Flash instead for now."
- ;;you can only call this once or webkit crashes and takes emacs with it. odd.
- (unless xwidget-webkit-kill-flash-oneshot
- (xwidget-disable-plugin-for-mime "application/x-shockwave-flash")
- (setq xwidget-webkit-kill-flash-oneshot t)))
-
-(xwidget-webkit-kill-flash)
-
-(defun report-xwidget-bug ()
- "Report a bug in GNU Emacs about the XWidget branch.
-Prompts for bug subject. Leaves you in a mail buffer."
- (interactive)
- (let ((reporter-prompt-for-summary-p t))
- (reporter-submit-bug-report "submit@debbugs.gnu.org" nil nil nil nil
- (format "Package: emacs-xwidgets
-
-Please describee xactly whata ctions triggered the bug, and the
-precise symptoms of the bug. If you can, give a recipe starting
-from `emacs -Q'.
-
-If Emacs crashed, and you have the Emacs process in the gdb
-deubbger, please include the output from the following gdb
-commands:
- `bt full' and `xbacktrace'.
-
-For information about debugging Emacs, please read the file
-%s" (expand-file-name "DEBUG" data-directory)))))
-
-(provide 'xwidget)
-
-;;; xwidget.el ends here
+2015-03-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * xlwmenu.c (pop_up_menu): Remove debugging code.
+
+2015-02-28 Jan Djärv <jan.h.d@swipnet.se>
+
+ * xlwmenu.c (remap_menubar): Re-realize menu to force move under
+ Gnome 3.
+
2015-01-04 Paul Eggert <eggert@cs.ucla.edu>
Less 'make' chatter for lwlib
if (mw->menu.horizontal && i == 1)
ws->y += mw->menu.margin;
+ /* WMs like Gnome 3 ignores requests to move windows. So we
+ must destroy the current one and create a new to get it to move. */
+ XtUnrealizeWidget (ws->w);
+ XtRealizeWidget (ws->w);
+ ws->window = XtWindow (ws->w);
+
size_menu (mw, i);
fit_to_screen (mw, ws, previous_ws, mw->menu.horizontal && i == 1);
create_pixmap_for_menu (ws, mw);
- XtMoveWidget (ws->w, ws->x, ws->y);
- XtPopup (ws->w, XtGrabNone);
- XtResizeWidget (ws->w, ws->width, ws->height,
- mw->core.border_width);
- XtResizeWindow (ws->w);
+ XtConfigureWidget (ws->w, ws->x, ws->y, ws->width, ws->height,
+ ws->w->core.border_width);
display_menu (mw, i, False, &selection_position, NULL, NULL);
+ XtPopup (ws->w, XtGrabNone);
}
/* unmap the menus that popped down */
1.2, 0x8000))
#else
XQueryColor (dpy, cmap, &topc);
- /* don't overflow/wrap! */
+ /* Don't overflow/wrap! */
topc.red = MINL (65535, topc.red * 1.2);
topc.green = MINL (65535, topc.green * 1.2);
topc.blue = MINL (65535, topc.blue * 1.2);
}
}
- if (!mw->menu.top_shadow_pixmap &&
- mw->menu.top_shadow_color == mw->core.background_pixel)
+ if (!mw->menu.top_shadow_pixmap
+ && mw->menu.top_shadow_color == mw->core.background_pixel)
{
mw->menu.top_shadow_pixmap = mw->menu.gray_pixmap;
if (mw->menu.free_top_shadow_color_p)
}
mw->menu.top_shadow_color = mw->menu.foreground;
}
- if (!mw->menu.bottom_shadow_pixmap &&
- mw->menu.bottom_shadow_color == mw->core.background_pixel)
+ if (!mw->menu.bottom_shadow_pixmap
+ && mw->menu.bottom_shadow_color == mw->core.background_pixel)
{
mw->menu.bottom_shadow_pixmap = mw->menu.gray_pixmap;
if (mw->menu.free_bottom_shadow_color_p)
if (fname && strcmp (fname, "none") != 0)
{
int screen = XScreenNumberOfScreen (mw->core.screen);
- int len = strlen (fname), i = len-1;
+ int len = strlen (fname), i = len - 1;
/* Try to convert Gtk-syntax (Sans 9) to Xft syntax Sans-9. */
while (i > 0 && '0' <= fname[i] && fname[i] <= '9')
--i;
static void
XlwMenuInitialize (Widget request, Widget w, ArgList args, Cardinal *num_args)
{
- /* Get the GCs and the widget size */
+ /* Get the GCs and the widget size. */
XlwMenuWidget mw = (XlwMenuWidget) w;
Window window = RootWindowOfScreen (DefaultScreenOfDisplay (XtDisplay (mw)));
Display* display = XtDisplay (mw);
/* Only the toplevel menubar/popup is a widget so it's the only one that
receives expose events through Xt. So we repaint all the other panes
- when receiving an Expose event. */
+ when receiving an Expose event. */
static void
XlwMenuRedisplay (Widget w, XEvent *ev, Region region)
{
release_drawing_gcs (mw);
release_shadow_gcs (mw);
- /* this doesn't come from the resource db but is created explicitly
- so we must free it ourselves. */
+ /* This doesn't come from the resource db but is created explicitly
+ so we must free it ourselves. */
XFreePixmap (XtDisplay (mw), mw->menu.gray_pixmap);
mw->menu.gray_pixmap = (Pixmap) -1;
/* Don't free mw->menu.contents because that comes from our creator.
The `*_stack' elements are just pointers into `contents' so leave
- that alone too. But free the stacks themselves. */
+ that alone too. But free the stacks themselves. */
if (mw->menu.old_stack) XtFree ((char *) mw->menu.old_stack);
if (mw->menu.new_stack) XtFree ((char *) mw->menu.new_stack);
if (mw->menu.windows [0].pixmap != None)
XFreePixmap (XtDisplay (mw), mw->menu.windows [0].pixmap);
- /* start from 1 because the one in slot 0 is w->core.window */
+ /* Start from 1 because the one in slot 0 is w->core.window. */
for (i = 1; i < mw->menu.windows_length; i++)
{
if (mw->menu.windows [i].pixmap != None)
XSetWindowBackground (XtDisplay (oldmw),
oldmw->menu.windows [i].window,
newmw->core.background_pixel);
- /* clear windows and generate expose events */
+ /* Clear windows and generate expose events. */
XClearArea (XtDisplay (oldmw), oldmw->menu.windows[i].window,
0, 0, 0, 0, True);
}
set_new_state (mw, val, level);
remap_menubar (mw);
- /* Sync with the display. Makes it feel better on X terms. */
+ /* Sync with the display. Makes it feel better on X terms. */
XSync (XtDisplay (mw), False);
}
int state = ev->state;
XMotionEvent oldev = *ev;
- /* allow motion events to be generated again */
+ /* Allow motion events to be generated again. */
if (ev->is_hint
&& XQueryPointer (XtDisplay (mw), ev->window,
&ev->root, &ev->subwindow,
releasing the button should always pop the menu down. */
next_release_must_exit = 1;
- /* notes the absolute position of the menubar window */
+ /* Notes the absolute position of the menubar window. */
mw->menu.windows [0].x = ev->xmotion.x_root - ev->xmotion.x;
mw->menu.windows [0].y = ev->xmotion.y_root - ev->xmotion.y;
- /* handles the down like a move, slots are compatible */
+ /* Handles the down like a move, slots are compatible. */
ev->xmotion.is_hint = 0;
handle_motion_event (mw, &ev->xmotion);
}
while (lw_separator_p (current->name, &separator, 0) || !current->enabled
|| (skip_titles && !current->call_data && !current->contents))
if (current->next)
- current=current->next;
+ current = current->next;
else
return NULL;
widget_value *current = item;
enum menu_separator separator;
- while (current->next && (current=current->next) &&
- (lw_separator_p (current->name, &separator, 0) || !current->enabled
- || (skip_titles && !current->call_data && !current->contents)))
+ while (current->next && (current = current->next)
+ && (lw_separator_p (current->name, &separator, 0) || !current->enabled
+ || (skip_titles && !current->call_data && !current->contents)))
;
if (current == item)
&& !current->contents))
{
if (current->next)
- current=current->next;
+ current = current->next;
if (current == item)
break;
widget_value *current = item;
widget_value *prev = item;
- while ((current=find_next_selectable (mw, current, skip_titles))
+ while ((current = find_next_selectable (mw, current, skip_titles))
!= item)
{
if (prev == current)
break;
- prev=current;
+ prev = current;
}
return prev;
< XtGetMultiClickTime (XtDisplay (w))))
return;
- /* pop down everything. */
+ /* Pop down everything. */
mw->menu.new_depth = 1;
remap_menubar (mw);
}
-\f/* Special code to pop-up a menu */
+\f/* Special code to pop-up a menu. */
static void
pop_up_menu (XlwMenuWidget mw, XButtonPressedEvent *event)
{
mw->menu.popped_up = True;
if (XtIsShell (XtParent ((Widget)mw)))
{
+ /* fprintf (stderr, "Config %d %d\n", x, y); */
XtConfigureWidget (XtParent ((Widget)mw), x, y, w, h,
XtParent ((Widget)mw)->core.border_width);
XtPopup (XtParent ((Widget)mw), XtGrabExclusive);
display_menu (mw, 0, False, NULL, NULL, NULL);
mw->menu.windows [0].x = x + borderwidth;
mw->menu.windows [0].y = y + borderwidth;
- mw->menu.top_depth = 1; /* Popup menus don't have a bar so top is 1 */
+ mw->menu.top_depth = 1; /* Popup menus don't have a bar so top is 1. */
}
else
{
XtAddGrab ((Widget) mw, True, True);
- /* notes the absolute position of the menubar window */
+ /* Notes the absolute position of the menubar window. */
mw->menu.windows [0].x = ev->xmotion.x_root - ev->xmotion.x;
mw->menu.windows [0].y = ev->xmotion.y_root - ev->xmotion.y;
mw->menu.top_depth = 2;
--- /dev/null
+# serial 22 -*- Autoconf -*-
+
+dnl Find out how to get the file descriptor associated with an open DIR*.
+
+# Copyright (C) 2001-2006, 2008-2015 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_DIRFD],
+[
+ AC_REQUIRE([gl_DIRENT_H_DEFAULTS])
+
+ dnl Persuade glibc <dirent.h> to declare dirfd().
+ AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
+
+ AC_CHECK_FUNCS([dirfd])
+ AC_CHECK_DECLS([dirfd], , ,
+ [[#include <sys/types.h>
+ #include <dirent.h>]])
+ if test $ac_cv_have_decl_dirfd = no; then
+ HAVE_DECL_DIRFD=0
+ fi
+
+ AC_CACHE_CHECK([whether dirfd is a macro],
+ gl_cv_func_dirfd_macro,
+ [AC_EGREP_CPP([dirent_header_defines_dirfd], [
+#include <sys/types.h>
+#include <dirent.h>
+#ifdef dirfd
+ dirent_header_defines_dirfd
+#endif],
+ gl_cv_func_dirfd_macro=yes,
+ gl_cv_func_dirfd_macro=no)])
+
+ # Use the replacement only if we have no function or macro with that name.
+ if test $ac_cv_func_dirfd = no && test $gl_cv_func_dirfd_macro = no; then
+ if test $ac_cv_have_decl_dirfd = yes; then
+ # If the system declares dirfd already, let's declare rpl_dirfd instead.
+ REPLACE_DIRFD=1
+ fi
+ fi
+])
+
+dnl Prerequisites of lib/dirfd.c.
+AC_DEFUN([gl_PREREQ_DIRFD],
+[
+ AC_CACHE_CHECK([how to get the file descriptor associated with an open DIR*],
+ [gl_cv_sys_dir_fd_member_name],
+ [
+ dirfd_save_CFLAGS=$CFLAGS
+ for ac_expr in d_fd dd_fd; do
+
+ CFLAGS="$CFLAGS -DDIR_FD_MEMBER_NAME=$ac_expr"
+ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
+ #include <sys/types.h>
+ #include <dirent.h>]],
+ [[DIR *dir_p = opendir("."); (void) dir_p->DIR_FD_MEMBER_NAME;]])],
+ [dir_fd_found=yes]
+ )
+ CFLAGS=$dirfd_save_CFLAGS
+ test "$dir_fd_found" = yes && break
+ done
+ test "$dir_fd_found" = yes || ac_expr=no_such_member
+
+ gl_cv_sys_dir_fd_member_name=$ac_expr
+ ]
+ )
+ if test $gl_cv_sys_dir_fd_member_name != no_such_member; then
+ AC_DEFINE_UNQUOTED([DIR_FD_MEMBER_NAME],
+ [$gl_cv_sys_dir_fd_member_name],
+ [the name of the file descriptor member of DIR])
+ fi
+ AH_VERBATIM([DIR_TO_FD],
+ [#ifdef DIR_FD_MEMBER_NAME
+# define DIR_TO_FD(Dir_p) ((Dir_p)->DIR_FD_MEMBER_NAME)
+#else
+# define DIR_TO_FD(Dir_p) -1
+#endif
+])
+])
-#serial 20
+#serial 24
dnl Copyright (C) 2002, 2005, 2007, 2009-2015 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
[
AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
AC_REQUIRE([AC_CANONICAL_HOST])
- AC_CHECK_FUNCS_ONCE([getdtablesize])
m4_ifdef([gl_FUNC_DUP2_OBSOLETE], [
AC_CHECK_FUNCS_ONCE([dup2])
if test $ac_cv_func_dup2 = no; then
if test $HAVE_DUP2 = 1; then
AC_CACHE_CHECK([whether dup2 works], [gl_cv_func_dup2_works],
[AC_RUN_IFELSE([
- AC_LANG_PROGRAM([[#include <unistd.h>
-#include <fcntl.h>
-#include <errno.h>]],
- [int result = 0;
-#ifdef HAVE_GETDTABLESIZE
- int bad_fd = getdtablesize ();
-#else
- int bad_fd = 1000000;
-#endif
-#ifdef FD_CLOEXEC
- if (fcntl (1, F_SETFD, FD_CLOEXEC) == -1)
- result |= 1;
-#endif
- if (dup2 (1, 1) == 0)
- result |= 2;
-#ifdef FD_CLOEXEC
- if (fcntl (1, F_GETFD) != FD_CLOEXEC)
- result |= 4;
-#endif
- close (0);
- if (dup2 (0, 0) != -1)
- result |= 8;
- /* Many gnulib modules require POSIX conformance of EBADF. */
- if (dup2 (2, bad_fd) == -1 && errno != EBADF)
- result |= 16;
- /* Flush out some cygwin core dumps. */
- if (dup2 (2, -1) != -1 || errno != EBADF)
- result |= 32;
- dup2 (2, 255);
- dup2 (2, 256);
- return result;
- ])
+ AC_LANG_PROGRAM(
+ [[#include <errno.h>
+ #include <fcntl.h>
+ #include <limits.h>
+ #include <sys/resource.h>
+ #include <unistd.h>
+ #ifndef RLIM_SAVED_CUR
+ # define RLIM_SAVED_CUR RLIM_INFINITY
+ #endif
+ #ifndef RLIM_SAVED_MAX
+ # define RLIM_SAVED_MAX RLIM_INFINITY
+ #endif
+ ]],
+ [[int result = 0;
+ int bad_fd = INT_MAX;
+ struct rlimit rlim;
+ if (getrlimit (RLIMIT_NOFILE, &rlim) == 0
+ && 0 <= rlim.rlim_cur && rlim.rlim_cur <= INT_MAX
+ && rlim.rlim_cur != RLIM_INFINITY
+ && rlim.rlim_cur != RLIM_SAVED_MAX
+ && rlim.rlim_cur != RLIM_SAVED_CUR)
+ bad_fd = rlim.rlim_cur;
+ #ifdef FD_CLOEXEC
+ if (fcntl (1, F_SETFD, FD_CLOEXEC) == -1)
+ result |= 1;
+ #endif
+ if (dup2 (1, 1) != 1)
+ result |= 2;
+ #ifdef FD_CLOEXEC
+ if (fcntl (1, F_GETFD) != FD_CLOEXEC)
+ result |= 4;
+ #endif
+ close (0);
+ if (dup2 (0, 0) != -1)
+ result |= 8;
+ /* Many gnulib modules require POSIX conformance of EBADF. */
+ if (dup2 (2, bad_fd) == -1 && errno != EBADF)
+ result |= 16;
+ /* Flush out some cygwin core dumps. */
+ if (dup2 (2, -1) != -1 || errno != EBADF)
+ result |= 32;
+ dup2 (2, 255);
+ dup2 (2, 256);
+ return result;]])
],
[gl_cv_func_dup2_works=yes], [gl_cv_func_dup2_works=no],
[case "$host_os" in
gl_cv_func_dup2_works="guessing no" ;;
cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0
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="guessing no" ;;
aix* | freebsd*)
# on AIX 7.1 and FreeBSD 6.1, dup2 (1,toobig) gives EMFILE,
# not EBADF.
gl_cv_func_dup2_works="guessing no" ;;
haiku*) # on Haiku alpha 2, dup2(1, 1) resets FD_CLOEXEC.
gl_cv_func_dup2_works="guessing no" ;;
+ *-android*) # implemented using dup3(), which fails if oldfd == newfd
+ gl_cv_func_dup2_works="guessing no" ;;
*) gl_cv_func_dup2_works="guessing yes" ;;
esac])
])
-# fcntl.m4 serial 5
+# fcntl.m4 serial 8
dnl Copyright (C) 2009-2015 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
AC_REQUIRE([gl_FCNTL_H_DEFAULTS])
AC_REQUIRE([AC_CANONICAL_HOST])
- AC_CHECK_FUNCS_ONCE([fcntl getdtablesize])
+ AC_CHECK_FUNCS_ONCE([fcntl])
if test $ac_cv_func_fcntl = no; then
gl_REPLACE_FCNTL
else
dnl haiku alpha 2 F_DUPFD has wrong errno
AC_CACHE_CHECK([whether fcntl handles F_DUPFD correctly],
[gl_cv_func_fcntl_f_dupfd_works],
- [AC_RUN_IFELSE([AC_LANG_PROGRAM([[
-#ifdef HAVE_GETDTABLESIZE
-# include <unistd.h>
-#endif
-#include <fcntl.h>
-#include <errno.h>
-]], [[int result = 0;
-#ifdef HAVE_GETDTABLESIZE
- int bad_fd = getdtablesize ();
-#else
- int bad_fd = 1000000;
-#endif
- if (fcntl (0, F_DUPFD, -1) != -1) result |= 1;
- if (errno != EINVAL) result |= 2;
- if (fcntl (0, F_DUPFD, bad_fd) != -1) result |= 4;
- if (errno != EINVAL) result |= 8;
- return result;
- ]])],
+ [AC_RUN_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <errno.h>
+ #include <fcntl.h>
+ #include <limits.h>
+ #include <sys/resource.h>
+ #include <unistd.h>
+ #ifndef RLIM_SAVED_CUR
+ # define RLIM_SAVED_CUR RLIM_INFINITY
+ #endif
+ #ifndef RLIM_SAVED_MAX
+ # define RLIM_SAVED_MAX RLIM_INFINITY
+ #endif
+ ]],
+ [[int result = 0;
+ int bad_fd = INT_MAX;
+ struct rlimit rlim;
+ if (getrlimit (RLIMIT_NOFILE, &rlim) == 0
+ && 0 <= rlim.rlim_cur && rlim.rlim_cur <= INT_MAX
+ && rlim.rlim_cur != RLIM_INFINITY
+ && rlim.rlim_cur != RLIM_SAVED_MAX
+ && rlim.rlim_cur != RLIM_SAVED_CUR)
+ bad_fd = rlim.rlim_cur;
+ if (fcntl (0, F_DUPFD, -1) != -1) result |= 1;
+ if (errno != EINVAL) result |= 2;
+ if (fcntl (0, F_DUPFD, bad_fd) != -1) result |= 4;
+ if (errno != EINVAL) result |= 8;
+ return result;]])],
[gl_cv_func_fcntl_f_dupfd_works=yes],
[gl_cv_func_fcntl_f_dupfd_works=no],
- [# Guess that it works on glibc systems
- case $host_os in #((
- *-gnu*) gl_cv_func_fcntl_f_dupfd_works="guessing yes";;
- *) gl_cv_func_fcntl_f_dupfd_works="guessing no";;
+ [case $host_os in
+ aix* | cygwin* | haiku*)
+ gl_cv_func_fcntl_f_dupfd_works="guessing no" ;;
+ *) gl_cv_func_fcntl_f_dupfd_works="guessing yes" ;;
esac])])
case $gl_cv_func_fcntl_f_dupfd_works in
*yes) ;;
-# getdtablesize.m4 serial 5
+# getdtablesize.m4 serial 6
dnl Copyright (C) 2008-2015 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
AC_REQUIRE([AC_CANONICAL_HOST])
AC_CHECK_FUNCS_ONCE([getdtablesize])
- if test $ac_cv_func_getdtablesize = yes; then
+ AC_CHECK_DECLS_ONCE([getdtablesize])
+ if test $ac_cv_func_getdtablesize = yes &&
+ test $ac_cv_have_decl_getdtablesize = yes; then
# Cygwin 1.7.25 automatically increases the RLIMIT_NOFILE soft limit
# up to an unchangeable hard limit; all other platforms correctly
# require setrlimit before getdtablesize() can report a larger value.
# Code from module crypto/sha256:
# Code from module crypto/sha512:
# Code from module dirent:
+ # Code from module dirfd:
# Code from module dosname:
# Code from module dtoastr:
# Code from module dtotimespec:
gl_UTIMENS
AC_C_VARARRAYS
gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false
+ gl_gnulib_enabled_dirfd=false
gl_gnulib_enabled_dosname=false
gl_gnulib_enabled_euidaccess=false
gl_gnulib_enabled_getdtablesize=false
gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=true
fi
}
+ func_gl_gnulib_m4code_dirfd ()
+ {
+ if ! $gl_gnulib_enabled_dirfd; then
+ gl_FUNC_DIRFD
+ if test $ac_cv_func_dirfd = no && test $gl_cv_func_dirfd_macro = no; then
+ AC_LIBOBJ([dirfd])
+ gl_PREREQ_DIRFD
+ fi
+ gl_DIRENT_MODULE_INDICATOR([dirfd])
+ gl_gnulib_enabled_dirfd=true
+ fi
+ }
func_gl_gnulib_m4code_dosname ()
{
if ! $gl_gnulib_enabled_dosname; then
if test $HAVE_FDOPENDIR = 0; then
func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b
fi
+ if test $HAVE_FDOPENDIR = 0; then
+ func_gl_gnulib_m4code_dirfd
+ fi
if test $HAVE_FSTATAT = 0 || test $REPLACE_FSTATAT = 1; then
func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b
fi
fi
m4_pattern_allow([^gl_GNULIB_ENABLED_])
AM_CONDITIONAL([gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b], [$gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b])
+ AM_CONDITIONAL([gl_GNULIB_ENABLED_dirfd], [$gl_gnulib_enabled_dirfd])
AM_CONDITIONAL([gl_GNULIB_ENABLED_dosname], [$gl_gnulib_enabled_dosname])
AM_CONDITIONAL([gl_GNULIB_ENABLED_euidaccess], [$gl_gnulib_enabled_euidaccess])
AM_CONDITIONAL([gl_GNULIB_ENABLED_getdtablesize], [$gl_gnulib_enabled_getdtablesize])
lib/count-trailing-zeros.c
lib/count-trailing-zeros.h
lib/dirent.in.h
+ lib/dirfd.c
lib/dosname.h
lib/dtoastr.c
lib/dtotimespec.c
m4/count-one-bits.m4
m4/count-trailing-zeros.m4
m4/dirent_h.m4
+ m4/dirfd.m4
m4/dup2.m4
m4/environ.m4
m4/errno_h.m4
+2015-03-27 Eli Zaretskii <eliz@gnu.org>
+
+ * inc/ms-w32.h (BROKEN_NON_BLOCKING_CONNECT): Don't define.
+ (Bug#20159)
+
+2015-03-09 Eli Zaretskii <eliz@gnu.org>
+
+ * INSTALL: Add some more installation instructions for mingw-get
+ users. (Bug#19989)
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * cmdproxy.c (get_next_token): Don't make backslashes disappear
+ without a trace when they are not followed by a quote.
+ (search_dir): Support searching programs whose file name already
+ has an arbitrary extension. (Bug#19817)
+ (main): When passing a command line to the shell, use cmd.exe
+ rules for quoting command-line tail.
+
+2015-02-27 Mark Laws <mdl@60hz.org>
+
+ Support daemon mode on MS-Windows (bug#19688)
+ * inc/ms-w32.h (W32_DAEMON_EVENT): New macro.
+
2015-01-16 Eli Zaretskii <eliz@gnu.org>
* Makefile.in (AM_V_CC, am__v_CC_, am__v_CC_0, am__v_CC_1)
. msys-base
. mingw-developer-toolkit
+ When the installation ends, perform the post-installation steps
+ described on this page of the MinGW site:
+
+ http://www.mingw.org/wiki/Getting_Started
+
+ in the "After Installing You Should ..." section. These steps are
+ important for making your installation complete, and in particular
+ will produce a desktop shortcut for running the MSYS Bash shell,
+ from which you will configure and build Emacs. Once you've made the
+ shortcut, double-click on it to open the MSYS Bash shell window,
+ where you will proceed with the rest of these instructions.
+
+ In addition, we suggest to modify your system-wide Path variable to
+ include the 'bin' subdirectory of your top-level MinGW installation
+ directory, the one you specified to mingw-get ("C:\MinGW" by
+ default). This will allow you to invoke the MinGW development
+ tools, like GCC, from the Windows cmd.exe shell windows or from
+ other Windows programs (including Emacs, after you build and install
+ it).
+
(We recommend that you refrain from installing the MSYS Texinfo
package, which is part of msys-base, because it might produce mixed
EOL format when installing Info files. Instead, install the MinGW
port of Texinfo, see the ezwinports URL below. To uninstall the
MSYS Texinfo, after installing it as part of msys-base, invoke the
- command "mingw-get remove msys-texinfo".)
+ command "mingw-get remove msys-texinfo", or mark "msys-texinfo" for
+ removal in the mingw-get GUI, then select Installation->Apply Changes.)
At this point, you should be ready to configure and build Emacs in
its basic configuration. Skip to the "Generating the configure
return str;
}
-int escape_char = '\\';
+/* This value is never changed by the code. We keep the code that
+ supports also the value of '"', but let's allow the compiler to
+ optimize it out, until someone actually uses that. */
+const int escape_char = '\\';
/* Get next token from input, advancing pointer. */
int
/* End of string, but no ending quote found. We might want to
flag this as an error, but for now will consider the end as
the end of the token. */
+ if (escape_char == '\\')
+ {
+ /* Output literal backslashes. Note that if the
+ token ends with an unpaired backslash, we eat it
+ up here. But since this case invokes undefined
+ behavior anyway, it's okay. */
+ while (escape_char_run > 1)
+ {
+ *o++ = escape_char;
+ escape_char_run -= 2;
+ }
+ }
*o = '\0';
break;
}
else
{
+ if (escape_char == '\\')
+ {
+ /* Output literal backslashes. Note that we don't
+ treat a backslash as an escape character here,
+ since it doesn't precede a quote. */
+ for ( ; escape_char_run > 0; escape_char_run--)
+ *o++ = escape_char;
+ }
*o++ = *p++;
}
}
int n_exts = sizeof (exts) / sizeof (char *);
char *dummy;
int i, rc;
+ const char *pext = strrchr (exec, '\\');
+
+ /* Does EXEC already include an extension? */
+ if (!pext)
+ pext = exec;
+ pext = strchr (pext, '.');
/* Search the directory for the program. */
- for (i = 0; i < n_exts; i++)
+ if (pext)
{
- rc = SearchPath (dir, exec, exts[i], bufsize, buffer, &dummy);
+ /* SearchPath will not append an extension if the file already
+ has an extension, so we must append it ourselves. */
+ char exec_ext[MAX_PATH], *p;
+
+ p = strcpy (exec_ext, exec) + strlen (exec);
+
+ /* Search first without any extension; if found, we are done. */
+ rc = SearchPath (dir, exec_ext, NULL, bufsize, buffer, &dummy);
if (rc > 0)
return rc;
+
+ /* Try the known extensions. */
+ for (i = 0; i < n_exts; i++)
+ {
+ strcpy (p, exts[i]);
+ rc = SearchPath (dir, exec_ext, NULL, bufsize, buffer, &dummy);
+ if (rc > 0)
+ return rc;
+ }
+ }
+ else
+ {
+ for (i = 0; i < n_exts; i++)
+ {
+ rc = SearchPath (dir, exec, exts[i], bufsize, buffer, &dummy);
+ if (rc > 0)
+ return rc;
+ }
}
return 0;
quotes, since they are illegal in path names). */
remlen = maxlen =
- strlen (progname) + extra_arg_space + strlen (cmdline) + 16;
+ strlen (progname) + extra_arg_space + strlen (cmdline) + 16 + 2;
buf = p = alloca (maxlen + 1);
/* Quote progname in case it contains spaces. */
remlen = maxlen - (p - buf);
}
+ /* Now that we know we will be invoking the shell, quote the
+ command line after the "/c" switch as the shell expects:
+ a single pair of quotes enclosing the entire command
+ tail, no matter whether quotes are used in the command
+ line, and how many of them are there. See the output of
+ "cmd /?" for how cmd.exe treats quotes. */
if (run_command_dot_com)
- _snprintf (p, remlen, " /e:%d /c %s", envsize, cmdline);
+ _snprintf (p, remlen, " /e:%d /c \"%s\"", envsize, cmdline);
else
- _snprintf (p, remlen, " /c %s", cmdline);
+ _snprintf (p, remlen, " /c \"%s\"", cmdline);
cmdline = buf;
}
else
Look in <sys/time.h> for a timeval structure. */
#define HAVE_TIMEVAL 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
-
/* And the select implementation does 1-byte read-ahead waiting
for received packets, so datagrams are broken too. */
#define BROKEN_DATAGRAM_SOCKETS 1
#endif
#endif
+/* Event name for when emacsclient starts the Emacs daemon on Windows. */
+#define W32_DAEMON_EVENT "EmacsServerEvent"
/* ============================================================ */
-2015-02-01 Joakim Verona <joakim@verona.se>
- Support for the new Xwidget feature.
- * window.c, Makefile.in, buffer.c, dispextern.h, dispnew.c, emacs.c:
- * emacsgtkfixed.c, emacsgtkfixed.h, keyboard.c, lisp.h, print.c:
- * termhooks.h, window.c, xdisp.c, xterm.c
- New files for xwidgets:
- * xwidget.c, xwidget.h:
- Support for testing xwidgets
- * xwidget-test-manual.el:
-
-2015-02-01 Grégoire Jadi <daimrod@gmail.com>
- Support for testing xwidgets
- * parallell-remote.el, parallell-xwidget.el, parallell.el:
- * xwidget-tests.el:
- various improvements to xwidgets:
- * xwidgets.c:
+2015-04-04 Jan Djärv <jan.h.d@swipnet.se>
+
+ * xselect.c (x_reply_selection_request)
+ (receive_incremental_selection): Call set_property_change_object
+ inside block_input.
+ (wait_for_property_change): Move set property_change_reply(_object)
+ outside of this function (Bug#16737).
+ (set_property_change_object): New function.
+
+2015-04-03 Jan Djärv <jan.h.d@swipnet.se>
+
+ * xterm.c (handle_one_xevent): Always redraw tool tips on
+ MapNotify. Update tool tip frame sizes on ConfigureNotify.
+
+2015-03-31 Eli Zaretskii <eliz@gnu.org>
+
+ * keyboard.c (read_key_sequence): Don't let
+ this_single_command_key_start become negative. (Bug#20223)
+
+2015-03-29 Jan Djärv <jan.h.d@swipnet.se>
+
+ * gtkutil.c (xg_display_open):
+ * xterm.c (x_display_ok, x_term_init): Block SIGIO when opening
+ a display (Bug#19175).
+
+2015-03-29 Martin Rudalics <rudalics@gmx.at>
+
+ * gtkutil.c (update_theme_scrollbar_width): Don't round up
+ scroll bar width with GTK3 (Bug#20182).
+
+2015-03-28 Jan Djärv <jan.h.d@swipnet.se>
+
+ * xsmfns.c (smc_save_yourself_CB): Return if Vinvocation_name or
+ user_login_name are not strings.
+
+2015-03-28 Eli Zaretskii <eliz@gnu.org>
+
+ * w32.c (sys_connect): Fix a mistake in previous commit that broke
+ blocking connections. (Bug#20159)
+
+2015-03-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Avoid some core dumps in X session management
+ Derived from a bug report by Nicolas Richard in:
+ http://bugs.gnu.org/20191#20
+ * xsmfns.c (smc_save_yourself_CB): Don't dump core if
+ invocation-name is not a string. Initialize user-login-name if it
+ is not already initialized, and don't dump core if it is not a
+ string.
+ (create_client_leader_window): Don't dump core if x-resource-name
+ and x-resource-class are not both strings.
+ (x_session_initialize): Don't dump core if x-session-previous-id,
+ invocation-directory, and invocation-name are not strings.
+
+ Port user-login-name initialization to Qnil == 0
+ Derived from a bug report by Nicolas Richard in:
+ http://bugs.gnu.org/20191#20
+ * editfns.c (Fuser_login_name, Fuser_real_login_name)
+ (syms_of_editfns): Don't rely on all-bits-zero being an Elisp integer,
+ as this is no longer true now that Qnil == 0.
+
+ Assume !BROKEN_NON_BLOCKING_CONNECT
+ From a suggestion by Eli Zaretskii in:
+ http://lists.gnu.org/archive/html/emacs-devel/2015-03/msg00824.html
+ * process.c (NON_BLOCKING_CONNECT): Simplify by assuming that
+ BROKEN_NON_BLOCKING_CONNECT is not defined.
+ (SELECT_CAN_DO_WRITE_MASK): Remove, and assume it's now true.
+
+2015-03-27 Eli Zaretskii <eliz@gnu.org>
+
+ * lread.c (substitute_object_recurse): For sub-char-tables, start
+ the recursive SUBSTITUTE loop from index of 2, to skip the
+ non-Lisp members of the sub-char-table. See the discussion at
+ http://lists.gnu.org/archive/html/emacs-devel/2015-03/msg00520.html
+ for the details.
+
+ Support non-blocking connect on MS-Windows.
+ Based on ideas from Kim F. Storm <storm@cua.dk>, see
+ http://lists.gnu.org/archive/html/emacs-devel/2006-12/msg00873.html.
+
+ * w32proc.c (reader_thread): If the FILE_CONNECT flag is set, call
+ '_sys_wait_connect'. If it returns STATUS_CONNECT_FAILED, exit
+ the thread with code 2.
+ (sys_select): Support 'wfds' in addition to 'rfds'. If a
+ descriptor in 'wfds' has its bit set, but the corresponding
+ fd_info member doesn't have its FILE_CONNECT flag set, ignore the
+ descriptor. Otherwise, acknowledge a successful non-blocking
+ connect by resetting the FILE_CONNECT flag and setting cp->status
+ to STATUS_READ_ACKNOWLEDGED. (Bug#20159)
+
+ * w32.h (STATUS_CONNECT_FAILED): New enumeration value.
+ (struct _child_process): New member 'errcode'.
+ (FILE_CONNECT): New flag.
+ (_sys_wait_connect): Add prototype.
+
+ * w32.c (pfn_WSAEnumNetworkEvents): New function pointer.
+ (init_winsock): Load WSAEnumNetworkEvents from winsock DLL.
+ (set_errno): Map WSAEWOULDBLOCK and WSAENOTCONN.
+ (sys_connect): Support non-blocking 'connect' calls by setting the
+ FILE_CONNECT flag in the fd_info member and returning EINPROGRESS.
+ (_sys_read_ahead): Add debug message if this function is called
+ for a descriptor that waits for a non-blocking connect to complete.
+ (_sys_wait_connect): New function.
+ (sys_read): Support STATUS_CONNECT_FAILED. Return the error code
+ recorded by _sys_wait_connect when the non-blocking connect
+ failed. Don't call WSAGetLastError before a call to set_errno had
+ a chance to use its value, since WSAGetLastError clears the last
+ error.
+
+2015-03-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * editfns.c (save_excursion_save): Don't save the mark.
+ (save_excursion_restore): Don't restore the mark.
+ (Fsave_excursion): Fix docstring accordingly.
+
+2015-03-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix minor ldexp issues
+ * floatfns.c (Fldexp): Require 2 args. Avoid undefined behavior
+ if the exponent is out of 'int' range. Improve documentation.
+ Fixes: bug#20185
+
+2015-03-24 Daniel Colascione <dancol@dancol.org>
+
+ * process.c (Fprocess_running_child_p): Return number identifier of
+ the foreground process group if we know it.
+
+2015-03-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Minor refactoring of new Fmake_process code
+ * process.c (Fmake_process): Refactor to avoid call to Flength, to
+ avoid cast to 'char **', and to reduce indenting and reuse of locals.
+
+2015-03-23 Daiki Ueno <ueno@gnu.org>
+
+ * process.c (Fmake_process): New function.
+ (create_process, create_pty): Check p->pty_flag instead of
+ Vprocess_connection_type.
+ (syms_of_process): Register QCcommand, QCconnection_type, Qpty,
+ Qpipe, and Smake_process. Unregister Sstart_process.
+
+2015-03-22 Jan Djärv <jan.h.d@swipnet.se>
+
+ * fontset.c (fontset_pattern_regexp): Replace + 1 with + 3 for
+ regexsize (Bug#20156).
+
+2015-03-21 Eli Zaretskii <eliz@gnu.org>
+
+ * emacs.c (synchronize_locale) [WINDOWSNT]: Ignore 'category' and
+ always use LC_ALL instead. Fixes problems with setting
+ system-time-locale to something non-default.
+
+2015-03-18 Glenn Morris <rgm@gnu.org>
+
+ * frame.h (x_set_bitmap_icon): Don't set the icon if icon-type is
+ nil/not present in the parameter alist. (Bug#19680)
+
+2015-03-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * alloc.c (purecopy): Handle hash-tables.
+
+2015-03-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuf.c (Fread_buffer): Add `predicate' argument.
+ * callint.c (Fcall_interactively): Adjust calls accordingly.
+
+2015-03-15 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (handle_invisible_prop): Fix up it->position even when
+ we are going to load overlays at the beginning of the invisible text.
+ (setup_for_ellipsis): Reset the ignore_overlay_strings_at_pos_p
+ flag also here.
+ (next_overlay_string): Set the overlay_strings_at_end_processed_p
+ flag only if the overlays just processed were actually loaded at EOB.
+
+2015-03-14 Daniel Colascione <dancol@dancol.org>
+
+ * emacs.c (standard_args): Add --no-x-resources.
+ (usage_message): Document that -Q implies --no-x-resources.
+
+2015-03-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ * frame.c (x_get_resource_string) [!USE_GTK]: Don't define.
+
+ * editfns.c, systime.h (mktime_z) [!HAVE_TZALLOC]: Now static.
+
+2015-03-12 Eli Zaretskii <eliz@gnu.org>
+
+ * w32font.c (font_supported_scripts): Add subranges for Latin
+ Supplement, Latin Extended-A/B, Vai, Supplemental Punctuation, Tai
+ Le, Buginese, Yijing Hexagrams, Ancient Greek Numbers, Tai Xuan
+ Jing, Counting Rods, Sundanese, Lepcha, Ol Chiki, Saurashtra,
+ Kayah Li, Rejang, Ancient Symbols, Phistos Disc, Carian, Lycian,
+ Lydian, Dominoe Tiles, and Mahjong Tiles. Break the Mathematical
+ Alphanumeric Symbols into several "scripts" like fontset.el does.
+ (Bug#19993)
+ (syms_of_w32font): DEFSYM all the new script symbols.
+
+2015-03-07 Eli Zaretskii <eliz@gnu.org>
+
+ * w32fns.c <ImmReleaseContext_Proc, ImmSetCompositionWindow_Proc>:
+ Fix typedefs to be consistent with the corresponding w32 API
+ signatures.
+ (w32_wnd_proc) <WM_IME_STARTCOMPOSITION>: Don't invoke
+ DefWindowProc if we successfully handled the message, as doing so
+ causes problems in displaying selection dialogs. (Bug#11732)
+
+2015-03-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Work around x86 glibc backtrace bug
+ * sysdep.c (emacs_backtrace): Don't dump core on x86.
+ Fixes: bug#19959
+
+2015-03-05 Eli Zaretskii <eliz@gnu.org>
+
+ * keyboard.c (make_lispy_position): When the click is on the
+ right-side vertical scroll bar, pass the rightmost X coordinate to
+ buffer_posn_from_coords, so that the returned text position
+ reflects the closest point to the click. Fixes region extension
+ when mouse moves outside the Emacs frame that has scroll bars on
+ the right.
+
+2015-03-04 Martin Rudalics <rudalics@gmx.at>
+
+ * frame.c (x_set_font): Try to keep frame height and width
+ unchanged if tool bar size changes with new font.
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * search.c (find_newline): Avoid assertion violations in
+ CHAR_TO_BYTE when a portion of the buffer was deleted and we look
+ for newlines near the end of the buffer. This happens in Rmail
+ when JIT font-lock fontifies a newly displayed portion of the
+ buffer.
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * w32fns.c (Fw32__menu_bar_in_use): New internal function.
+ (Bug#19925)
+
+2015-03-03 Glenn Morris <rgm@gnu.org>
+
+ * fileio.c (Fmake_temp_name): Doc tweaks. (Bug#19858)
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * menu.c (Fx_popup_menu) [HAVE_X_WINDOWS]: Call
+ mouse_position_for_popup only for X frames. (Bug#19862)
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * buffer.c (syms_of_buffer): Doc fix. (Bug#19841)
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * xfaces.c (map_tty_color): Use assoc_no_quit instead of
+ assq_no_quit to fetch color definition by its string name.
+ (Bug#19802)
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (move_it_in_display_line_to): Handle the case where the
+ last character of a screen line is whitespace, and we are under
+ word-wrap with overflow-newline-into-fringe turned on.
+ (Bug#19769)
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (handle_stop, handle_single_display_spec)
+ (next-element_from_image): Don't reset the
+ ignore_overlay_strings_at_pos_p flag here.
+ (next_element_from_buffer): Reset ignore_overlay_strings_at_pos_p
+ here.
+ (next_overlay_string): Set ignore_overlay_strings_at_pos_p here,
+ after we've exhausted all the overlay strings at the current
+ position. (Bug#19307)
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * xdisp.c (set_iterator_to_next): Set value of stop_charpos
+ according to the object we are about to resume iterating.
+ (Bug#19307)
+
+ * dispnew.c (adjust_glyph_matrix): Set the update_mode_line flag
+ of the window whose current glyph matrix was resized, which
+ disables the mode-line row as side effect.
+
+ * xdisp.c (redisplay_window): Don't avoid redisplay of a window
+ whose update_mode_line flag is set. (Bug#19721)
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * dispextern.h (FACE_FOR_CHAR): Fix the commentary.
+
+2015-03-03 Daniel Colascione <dancol@dancol.org>
+
+ * alloc.c (syms_of_alloc): Rename `gc-precise-p' to `gc-precise'.
+
+2015-03-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ * alloc.c (run_finalizers): Omit unused local.
+ Also, redo newly-added code as per usual Emacs style.
+
+2015-03-03 Martin Rudalics <rudalics@gmx.at>
+
+ * frame.c (adjust_frame_size): If the pixel sizes remain
+ unchanged but the number of lines or columns of the frame
+ changes, run `window--pixel-to-total' (Bug#19972).
+ (Qwindow_pixel_to_total): DEFSYM it.
+
+2015-03-03 Daniel Colascione <dancol@dancol.org>
+
+ * print.c (print_object): Print whether a finalizer has
+ been called.
+
+ * data.c (Ftype_of): Make `type-of' work with finalizers.
+ (syms_of_data): Register Qfinalizer.
+
+2015-03-02 Daniel Colascione <dancol@dancol.org>
+
+ * print.c (print_object): Print finalizers.
+
+ * alloc.c:
+ (finalizers, doomed_finalizers): New variables.
+ (init_finalizer_list, finalizer_insert, unchain_finalizer)
+ (mark_finalizer_list, queue_doomed_finalizers)
+ (run_finalizer_handler, run_finalizer_function, run_finalizers):
+ New functions.
+ (garbage_collect_1, mark_object, sweep_misc)
+ (init_alloc_once, syms_of_alloc): Support finalizers.
+ (gc-precise-p): New Lisp variable.
+
+ * lisp.h (Lisp_Misc_Type): New value Lisp_Misc_Finalizer.
+ (FINALIZERP, XFINALIZER): New functions.
+ (Lisp_Finalizer): New structure.
+
+2015-02-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ * character.c (alphabeticp, decimalnump): Avoid undefined behavior
+ if CATEGORY is not an integer, or is an integer out of
+ unicode_category_t range.
+
+2015-02-28 Martin Rudalics <rudalics@gmx.at>
+
+ * frame.c (make_initial_frame, Fmake_terminal_frame):
+ Set can_x_set_window_size and after_make_frame (Bug#19962).
+
+2015-02-28 Eli Zaretskii <eliz@gnu.org>
+
+ * character.c (alphabeticp, decimalnump): New functions.
+ * character.h (alphabeticp, decimalnump): Add prototypes.
+
+ * regex.c (ISALNUM, ISALPHA): Check Unicode character properties
+ for multibyte characters by calling alphabeticp and decimalnump.
+ (BIT_ALPHA, BIT_ALNUM): New bit masks.
+ (re_wctype_to_bit): Return them when the class is RECC_ALPHA or
+ RECC_ALNUM.
+ (re_match_2_internal): Call ISALPHA and ISALNUM when appropriate.
+ (Bug#19878)
+
+2015-02-27 Jan Djärv <jan.h.d@swipnet.se>
+
+ * xterm.h (x_real_pos_and_offsets): Take outer_border as arg also.
+
+ * xmenu.c (x_menu_show): Adjust for new arg to x_real_pos_and_offsets.
+
+ * xfns.c (x_real_pos_and_offsets): Take outer_border as arg also.
+ Initialize all args. Get outer_border from window attributes.
+ Fix typo for top_offset_y.
+ (x_real_positions): Adjust for new arg to x_real_pos_and_offsets.
+ (Fx_frame_geometry): Get outer_border also. Use attrs.width/height.
+
+2015-02-27 Mark Laws <mdl@60hz.org>
+
+ Support daemon mode on MS-Windows (bug#19688)
+ * emacs.c <w32_daemon_event> [WINDOWSNT]: New global var.
+ (main) [WINDOWSNT]: Initialize it to NULL. Create the event to
+ signal clients we are ready for connections.
+ (Fdaemon_initialized): Use DAEMON_RUNNING.
+ [WINDOWSNT]: MS-Windows specific code to signal clients we are
+ ready for connections.
+
+ * lisp.h (DAEMON_RUNNING): New macro, encapsulates Posix and
+ MS-Windows conditions for running in daemon mode.
+
+ * minibuf.c (read_minibuf): Use DAEMON_RUNNING.
+
+ * keyboard.c (kbd_buffer_get_event): Use DAEMON_RUNNING.
+
+ * dispnew.c (init_display) [WINDOWSNT]: Initialize frames/terminal
+ even in daemon mode.
+
+2015-02-26 Jan Djärv <jan.h.d@swipnet.se>
+
+ * xmenu.c (create_and_show_popup_menu): Call XTranslateCoordinates,
+ dont use OUTER_TO_INNER macros.
+ (x_menu_show): Call x_real_pos_and_offsets, don't use
+ OUTER_TO_INNER macros.
+
+2015-02-26 Eli Zaretskii <eliz@gnu.org>
+
+ * dispextern.h (FACE_FOR_CHAR): Fix the commentary.
+
+2015-02-26 Hans Wennborg <hwennborg@google.com> (tiny change)
+
+ * emacs.c (decode_env_path): Add parentheses around ternary
+ operator to increase readability and pacify compiler warnings.
+
+2015-02-26 Eli Zaretskii <eliz@gnu.org>
+
+ * w32.c (sys_readdir): Map ERROR_NOT_READY (as in "device not
+ ready") to ENOENT.
+
+2015-02-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ * xfns.c (x_real_pos_and_offsets): Fix pointer signedness.
+
+2015-02-25 Jan Djärv <jan.h.d@swipnet.se>
+
+ * xterm.h (struct x_output): Remove x_pixels_outer_diff,
+ y_pixels_outer_diff, FRAME_OUTER_TO_INNER_DIFF_X,
+ FRAME_OUTER_TO_INNER_DIFF_Y. Declare x_real_pos_and_offsets.
+
+ * xmenu.c (create_and_show_popup_menu): Use XTranslateCoordinates
+ instead of OUTER_TO_INNER_DIFF macros.
+
+ * xfns.c (x_real_pos_and_offsets): New function, basically the code
+ from x_real_positions.
+ (x_real_positions): Call x_real_pos_and_offsets.
+ (x_relative_mouse_position): Use XTranslateCoordinates instead of
+ OUTER_TO_INNER_DIFF macros.
+ (Fx_frame_geometry): Get offsets with x_real_pos_and_offsets,
+ border from window attributes. Adjust tool bar and menu widths.
+
+ * w32fns.c (x_real_positions): Remove setting of x_pixels_diff,
+ y_pixels_diff.
+
+ * frame.h (struct frame): Remove x_pixels_diff, y_pixels_diff.
+
+2015-02-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Backtrace after malloc arena is corrupted
+ Without this change, if the malloc arena is corrupted and then
+ 'backtrace' is called, the backtrace can crash because 'backtrace'
+ calls 'malloc'. For more, please see:
+ https://sourceware.org/ml/libc-alpha/2015-02/msg00678.html
+ * emacs.c (main): Initialize tables used by 'backtrace'.
+ * sysdep.c (emacs_backtrace): Document the newly used part of the API.
+
+2015-02-22 Jan Djärv <jan.h.d@swipnet.se>
+
+ * nsfns.m (Fx_frame_geometry): New function.
+ (syms_of_nsfns): Defsubr Sx_frame_geometry.
+
+2015-02-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes
+ * lisp.h (DEFINE_NON_NIL_Q_SYMBOL_MACROS):
+ Rename from DEFINE_NONNIL_Q_SYMBOL_MACROS. All uses changed.
+
+2015-02-21 Eli Zaretskii <eliz@gnu.org>
+
+ * w32term.c (queue_notifications):
+ * w32inevt.c (handle_file_notifications):
+ * w32font.c (w32_enumfont_pattern_entity): Prefer 'Qfoo' to
+ 'intern ("foo")'.
+
+2015-02-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer 'Qfoo' to 'intern ("foo")'
+ * buffer.c (syms_of_buffer):
+ * bytecode.c (exec_byte_code):
+ * callint.c (Fcall_interactively):
+ * callproc.c (create_temp_file):
+ * charset.c (define_charset_internal):
+ * coding.c (syms_of_coding):
+ * editfns.c (syms_of_editfns):
+ * emacs.c (main):
+ * fns.c (syms_of_fns):
+ * frame.c (delete_frame, Fframe_parameters):
+ * keyboard.c (syms_of_keyboard):
+ * keymap.c (syms_of_keymap):
+ * minibuf.c (read_minibuf, syms_of_minibuf):
+ * nsfns.m (ns_cursor_type_to_lisp):
+ * textprop.c (syms_of_textprop):
+ * xdisp.c (Fformat_mode_line, syms_of_xdisp):
+ * xfns.c (x_create_tip_frame, Fx_select_font):
+ * xml.c (parse_region):
+ Prefer constants like 'Qfoo' to calls like 'intern ("foo")'.
+ * buffer.c (syms_of_buffer): OK to do (put 'erase-buffer 'disabled
+ t) here now ...
+ (keys_of_buffer): ... instead of here.
+ * ftfont.c (syms_of_ftfont): Move DEFSYM of Qmono from here ...
+ * xfns.c (syms_of_xfns): ... to here, since ftfont.c is more
+ optional than xfns.c.
+
+2015-02-20 Jan Djärv <jan.h.d@swipnet.se>
+
+ * emacs.c (terminate_due_to_signal): Move totally_unblock_input after
+ setting fatal_error_in_progress, so gobble_input and *read_socket are
+ not read if there are pending_signals.
+
+2015-02-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify binary I/O configuration
+ * lread.c (Fload): Prefer FOPEN_TEXT and FOPEN_BINARY to #ifdef DOS_NT.
+ * sysstdio.h: Add copyright notice. Include <fcntl.h>.
+ (FOPEN_BINARY, FOPEN_TEXT): New macros.
+ * xfaces.c (Fx_load_color_file): Use FOPEN_TEXT, since POSIX
+ doesn't guarantee that "t" will work.
+
+2015-02-19 Eli Zaretskii <eliz@gnu.org>
+
+ * keyboard.c (read_char): Make sure this_single_command_key_start
+ is in sync with this_command_key_count, around the call to
+ input-method-function. (Bug#19774)
+
+2015-02-19 Fujii Hironori <fujii.hironori@gmail.com> (tiny change)
+
+ * w32fns.c (w32_wnd_proc) <WM_IME_STARTCOMPOSITION>: Pass the
+ message to DefWindowProc, after positioning the IME window, to
+ trigger its display. (Bug#11732)
+
+2015-02-18 Eli Zaretskii <eliz@gnu.org>
+
+ * emacs.c (Fkill_emacs): Exit with specified exit code even if
+ stdin is at EOF. (Bug#19897)
+
+2015-02-18 Oscar Fuentes <ofv@wanadoo.es>
+
+ * keyboard.c (read_char): When there is an input method function,
+ do not restore the echo area if a prefix argument is being
+ introduced. (Bug#19875)
+
+2015-02-16 Kelly Dean <kelly@prtime.org>
+
+ * src/keyboard.c (timer_check_2): Fix incorrect comment.
+
+2015-02-14 Martin Rudalics <rudalics@gmx.at>
+
+ * xterm.c (x_frame_normalize_before_maximize): Fix doc-string.
+ Suggested by Alan Mackenzie <acm@muc.de>.
+
+2015-02-14 Eli Zaretskii <eliz@gnu.org>
+
+ * menu.c (Fx_popup_menu) [HAVE_X_WINDOWS]: Call
+ x_relative_mouse_position only for X frames. (Bug#19862)
+
+2015-02-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Better support for future plugins
+ * lisp.h (DEFINE_LISP_SYMBOL): New macro, replacing and simplifying
+ DEFINE_LISP_SYMBOL_BEGIN / DEFINE_LISP_SYMBOL_END. All uses changed.
+ (DEFINE_NONNIL_Q_SYMBOL_MACROS): New macro, defaulting to true.
+
+2015-02-11 Martin Rudalics <rudalics@gmx.at>
+
+ * w32term.c (w32_read_socket): In SIZE_MAXIMIZED and
+ SIZE_RESTORED cases correctly handle `maximized' value for the
+ `fullscreen' parameter. Don't use 'maximized' frame parameter
+ any more.
+ (w32fullscreen_hook): Include menu bar height when calculating
+ new text height in FULLSCREEN_BOTH case.
+ * xterm.c (do_ewmh_fullscreen): Handle transition from
+ FULLSCREEN_BOTH to FULLSCREEN_MAXIMIZED when
+ x_frame_normalize_before_maximize is set.
+
+2015-02-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use bool for boolean in xdisp.c
+ * dispextern.h (display_prop_intangible_p, resize_mini_window)
+ (pixel_to_glyph_coords, mark_window_display_accurate)
+ (compute_display_string_pos, handle_tool_bar_click)
+ (x_intersect_rectangles, clear_mouse_face, display_tty_menu_item):
+ * lisp.h (setup_echo_area_for_printing, message_with_string)
+ (pos_visible_p): Use bool for boolean.
+ * xdisp.c: Use bool, true, false intstead of int, 1, 0.
+ Remove unnecessary forward decls.
+ (trace_move) [DEBUG_TRACE_MOVE]: Now static.
+ (CHECK_IT, CHECK_WINDOW_END):
+ Now an inline function that is always defined.
+ (check_it) [0]:
+ (check_window_end) [oGLYPH_DEBUG && ENABLE_CHECKING]:
+ Remove; no longer needed.
+ (handle_stop): Prefer (X && !Y) to (X ? !Y : 0).
+ (get_overlay_strings): Omit unnecessary casts.
+ (forward_to_next_line_start):
+ (Ftool_bar_height):
+ Prefer !BOOL to (BOOL ? 0 : 1).
+ (next_element_function): New typedef.
+ (get_next_element): Use it. Now const.
+ (IT_POS_VALID_AFTER_MOVE_P): Prefer !X || Y==0 to (X ? Y==0 : 1).
+ (vmessage): Now ATTRIBUTE_FORMAT_PRINTF (1, 0), to pacify GCC 4.9.2
+ (display_echo_area): Prefer BOOLEXPR to BOOLEXPR ? 1 : 0.
+ (tool_bar_item_info): Simplify.
+ (invisible_prop): Rename from invisible_p, since it doesn't
+ return bool. All callers changed.
+ (x_produce_glyphs): Simplify.
+
+2015-02-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Check for some overflows in vertical-motion
+ * indent.c (window_column_x): New function.
+ (Fvertical_motion): Use it to protect against integer overflow
+ when computing column. Prefer extract_float to doing things by hand.
+ Avoid unnecessary casts.
+
+ * xfont.c: Minor style fixes
+ (xfont_list_pattern): Reindent to 80 cols and use Emacs-style comments.
+ Redo loop so that less indentation is needed.
+
+2015-02-09 Eli Zaretskii <eliz@gnu.org>
+
+ * indent.c (Fvertical_motion): Accept an additional argument
+ CUR-COL and use it as the starting screen coordinate.
+ * window.c (window_scroll_line_based, Fmove_to_window_line):
+ All callers of vertical-motion changed.
+
+2015-02-09 Dima Kogan <dima@secretsauce.net>
+
+ * font.c (font_score): Remove unused variable assignment.
+
+2015-02-09 Dima Kogan <dima@secretsauce.net>
+
+ * xfaces.c (realize_basic_faces): Don't set Qscalable_fonts_allowed to
+ t.
+ * font.c (font_score): Try to find a font without scaling first,
+ and only accept scalable fonts if we did not get a match (Bug#19117).
+
+2015-02-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * keyboard.c (syms_of_keyboard): Use non-nil default value.
+
+2015-02-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use C99's INFINITY and NAN macros
+ * lread.c: Include <math.h>.
+ (string_to_number): Use INFINITY and NAN rather than rolling our own.
+ This avoids some runtime diagnostics when building with
+ gcc -fsanitize=undefined.
+
+ Fix bidi_explicit_dir_char undefined behavior
+ * bidi.c (bidi_explicit_dir_char): Avoid subscript error when
+ argument is BIDI_EOB. This can happen in bidi_level_of_next_char.
+
+ Better distinguish infinite from invalid times
+ * editfns.c (check_time_validity): New function.
+ (decode_time_components): Return int, not bool.
+ Return -1 (not 0) if the time is out of range.
+ All callers changed.
+ (lisp_time_struct, lisp_seconds_argument): Distinguish better
+ between time overflow and invalid time values.
+
+2015-02-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Minor tweaks to frame_size_history_add
+ * frame.c (frame_size_history_add): Don't assume length fits in 'int'.
+ Prefer XCAR and XCDR to Fcar and Fcdr when the arg is a cons.
+ (Fframe_after_make_frame): Simplify.
+ * gtkutil.c: Remove commented-out code.
+ * xfns.c (Fx_create_frame): Fix indenting.
+
+2015-02-08 Eli Zaretskii <eliz@gnu.org>
+
+ * frame.c (Fframe_parameter): Don't replace a non-nil value of
+ foreground-color or background-color parameters with a nil value.
+ (Bug#19802)
+
+2015-02-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * data.c (Findirect_function): Like `symbol-function', don't signal an
+ error for void functions any more.
+
+2015-02-07 Martin Rudalics <rudalics@gmx.at>
+
+ * frame.c (frame_size_history_add): New function.
+ (frame_inhibit_resize): Consider frame_inhibit_implied_resize
+ only after frame's after_make_frame slot is true.
+ Inhibit resizing fullwidth-/height frames in one direction only.
+ Update frame_size_history.
+ (adjust_frame_size): Call frame_size_history_add.
+ (make_frame): Initalize after_make_frame slot.
+ (Fmake_terminal_frame): Adjust adjust_frame_size call.
+ (Fcan_run_window_configuration_change_hook): Rename to
+ Fframe_after_make_frame. Set after_make_frame slot.
+ Return second argument.
+ (x_set_frame_parameters): Postpone handling fullscreen parameter
+ until after width and height parameters have been set.
+ Apply width and height changes only if can_x_set_window_size is true.
+ Update frame_size_history.
+ (Qadjust_frame_size_1, Qadjust_frame_size_2)
+ (Qadjust_frame_size_3, QEmacsFrameResize, Qframe_inhibit_resize)
+ (Qx_set_fullscreen, Qx_check_fullscreen, Qx_set_window_size_1)
+ (Qxg_frame_resized, Qxg_frame_set_char_size_1)
+ (Qxg_frame_set_char_size_2, Qxg_frame_set_char_size_3)
+ (Qxg_change_toolbar_position, Qx_net_wm_state)
+ (Qx_handle_net_wm_state, Qtb_size_cb, Qupdate_frame_tool_bar)
+ (Qfree_frame_tool_bar): New symbol for updating frame_size_history.
+ (Qtip_frame, Qterminal_frame): New symbols.
+ (Vframe_adjust_size_history): Rename to frame_size_history.
+ * frame.h (struct frame):
+ Rename can_run_window_configuration_change_hook slot to
+ after_make_frame.
+ (frame_size_history_add): Extern.
+ * gtkutil.c (xg_frame_resized): Call frame_size_history_add.
+ Don't set FRAME_PIXEL_WIDTH and FRAME_PIXEL_HEIGHT here.
+ (xg_frame_set_char_size): Try to preserve the status of
+ fullwidth/-height frames. Call frame_size_history_add.
+ (tb_size_cb, update_frame_tool_bar, free_frame_tool_bar)
+ (xg_change_toolbar_position): Call frame_size_history_add.
+ * w32fns.c (x_change_tool_bar_height): Handle frame's fullscreen
+ status.
+ (Fx_create_frame): Process fullscreen parameter after frame has
+ been resized.
+ (x_create_tip_frame): Pass Qtip_frame to adjust_frame_size.
+ (Fx_frame_geometry): Don't pollute pure storage.
+ * w32term.c (w32_read_socket): For WM_WINDOWPOSCHANGED,
+ WM_ACTIVATE and WM_ACTIVATEAPP set frame's visibility before
+ calling w32fullscreen_hook. For WM_DISPLAYCHANGE call
+ w32fullscreen_hook immediately.
+ (x_fullscreen_adjust, x_check_fullscreen): Remove.
+ (w32fullscreen_hook): Call change_frame_size just as with a
+ "normal" frame resize operation. Call do_pending_window_change.
+ (x_set_window_size): Try to handle fullwidth and fullheight more
+ accurately. Don't rely on w32_enable_frame_resize_hack.
+ (w32_enable_frame_resize_hack): Remove variable.
+ * widget.c (EmacsFrameResize): Remove dead code.
+ Call frame_size_history_add
+ * window.c (run_window_configuration_change_hook):
+ Check f->after_make_frame instead of
+ f->can_run_window_configuration_change_hook.
+ * xfns.c (x_change_tool_bar_height): Handle frame's fullscreen status.
+ (Fx_create_frame): Process fullscreen parameter after frame has
+ been resized.
+ (Fx_frame_geometry): Don't pollute pure storage.
+ * xterm.c (x_net_wm_state, x_handle_net_wm_state):
+ Call frame_size_history_add.
+ (do_ewmh_fullscreen): Handle x_frame_normalize_before_maximize.
+ (x_check_fullscreen): Count in menubar when calling
+ XResizeWindow. Wait for ConfigureNotify event.
+ Call frame_size_history_add.
+ (x_set_window_size_1): Remove PIXELWISE argument. Try to handle
+ changing a fullheight frame's width or a fullwidth frame's
+ height. Call frame_size_history_add.
+ (x_set_window_size): Simplify xg_frame_set_char_size and
+ x_set_window_size_1 calls.
+ (x_frame_normalize_before_maximize): New variable.
+
+2015-02-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove no-longer-used cursor_in_echo_area code
+ * dispnew.c (set_window_cursor_after_update, update_frame_1):
+ Remove checks for negative cursor_in_echo_area, since this var is
+ a boolean, and has been a boolean for some time. Simplify.
+ * dispnew.c (init_display):
+ * xdisp.c (message3_nolog, vmessage): Use bool for boolean.
+
+2015-02-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eval.c (Ffunction): Handle the new (:documentation ...) form.
+ (syms_of_eval): Declare `:documentation'.
+
+2015-02-05 Martin Rudalics <rudalics@gmx.at>
+
+ * xdisp.c (Fwindow_text_pixel_size): Remove optional BUFFER
+ argument added on 2015-02-01.
+
+2015-02-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove no-longer-used two_byte_p calculations
+ * dispextern.h (struct glyph_string): Remove member two_byte_p.
+ All uses removed.
+ * xdisp.c (get_glyph_face_and_encoding): Remove arg two_byte_p.
+ All callers changed.
+
+2015-02-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Omit unnecessary var if GTK or NS
+ * frame.c, frame.h (frame_default_tool_bar_height) [USE_GTK||HAVE_NS]:
+ Now a constant zero on these platforms.
+
+2015-02-01 Martin Rudalics <rudalics@gmx.at>
+
+ * xdisp.c (Fwindow_text_pixel_size): Add optional argument BUFFER.
2015-01-31 Eli Zaretskii <eliz@gnu.org>
(x_horizontal_scroll_bar_report_motion, w32_read_socket)
(w32_set_vertical_scroll_bar, w32_set_horizontal_scroll_bar)
(w32_draw_window_cursor, x_new_font, x_set_offset)
- (x_set_window_size, x_make_frame_invisible, x_iconify_frame): Use
- bool where appropriate.
+ (x_set_window_size, x_make_frame_invisible, x_iconify_frame):
+ Use bool where appropriate.
Use bool for boolean in w32fns.c
* w32fns.c (w32_defined_color, x_decode_color)
Qx_create_frame_2 to adjust_frame_size.
* w32menu.c (set_frame_menubar): Simplify adjust_frame_size
call.
- * window.c (Fset_window_configuration): Pass
- Qset_window_configuration to adjust_frame_size.
+ * window.c (Fset_window_configuration):
+ Pass Qset_window_configuration to adjust_frame_size.
* xdisp.c (redisplay_tool_bar): Assign new height to
frame_default_tool_bar_height.
(redisplay_internal): If we haven't redisplayed this frame's
* w32fns.c (Fw32_register_hot_key): Use XINT instead of XLI.
- * w32notify.c (Fw32notify_add_watch, w32_get_watch_object): Use
- make_pointer_integer instead of XIL.
+ * w32notify.c (Fw32notify_add_watch, w32_get_watch_object):
+ Use make_pointer_integer instead of XIL.
(Fw32notify_rm_watch): Use XINTPTR instead of XLI.
* w32inevt.c (handle_file_notifications): Use make_pointer_integer
2015-01-06 Jan Djärv <jan.h.d@swipnet.se>
* nsterm.m (x_set_window_size): Call updateFrameSize to get real
- size instead of using widht/height. The frame may be constrained.
+ size instead of using widht/height. The frame may be
+ constrained (Bug#19482).
2015-01-05 Paul Eggert <eggert@cs.ucla.edu>
RSVG_LIBS= @RSVG_LIBS@
RSVG_CFLAGS= @RSVG_CFLAGS@
-WEBKIT_LIBS= @WEBKIT_LIBS@
-WEBKIT_CFLAGS= @WEBKIT_CFLAGS@
-
-GIR_LIBS= @GIR_LIBS@
-GIR_CFLAGS= @GIR_CFLAGS@
-
IMAGEMAGICK_LIBS= @IMAGEMAGICK_LIBS@
IMAGEMAGICK_CFLAGS= @IMAGEMAGICK_CFLAGS@
$(GNUSTEP_CFLAGS) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \
$(PNG_CFLAGS) $(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \
$(XRANDR_CFLAGS) $(XINERAMA_CFLAGS) $(XFIXES_CFLAGS) \
- $(WEBKIT_CFLAGS) $(GIR_CFLAGS) \
$(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
$(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \
$(LIBGNUTLS_CFLAGS) $(GFILENOTIFY_CFLAGS) \
process.o gnutls.o callproc.o \
region-cache.o sound.o atimer.o \
doprnt.o intervals.o textprop.o composite.o xml.o $(NOTIFY_OBJ) \
- xwidget.o \
profiler.o decompress.o \
$(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
$(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ)
obj = $(base_obj) $(NS_OBJC_OBJ)
-xwidget.o: xwidget.c xwidget.h
## Object files used on some machine or other.
## These go in the DOC file on all machines in case they are needed.
## Some of them have no DOC entries, but it does no harm to have them
LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \
$(LIBX_OTHER) $(LIBSOUND) \
$(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_ACL) $(LIB_CLOCK_GETTIME) \
- $(WEBKIT_LIBS) $(GIR_LIBS) \
$(LIB_EACCESS) $(LIB_FDATASYNC) $(LIB_TIMER_TIME) $(DBUS_LIBS) \
$(LIB_EXECINFO) $(XRANDR_LIBS) $(XINERAMA_LIBS) $(XFIXES_LIBS) \
$(LIBXML2_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \
return pointers_fit_in_lispobj_p () && !might_dump;
}
+/* Head of a circularly-linked list of extant finalizers. */
+static struct Lisp_Finalizer finalizers;
+
+/* Head of a circularly-linked list of finalizers that must be invoked
+ because we deemed them unreachable. This list must be global, and
+ not a local inside garbage_collect_1, in case we GC again while
+ running finalizers. */
+static struct Lisp_Finalizer doomed_finalizers;
+
\f
/************************************************************************
Malloc
};
/* Allocation of markers and other objects that share that structure.
- Works like allocation of conses. */
+ Works like allocation of conses. */
#define MARKER_BLOCK_SIZE \
((1020 - sizeof (struct marker_block *)) / sizeof (union aligned_Lisp_Misc))
}
}
+static void
+init_finalizer_list (struct Lisp_Finalizer *head)
+{
+ head->prev = head->next = head;
+}
+
+/* Insert FINALIZER before ELEMENT. */
+
+static void
+finalizer_insert (struct Lisp_Finalizer *element,
+ struct Lisp_Finalizer *finalizer)
+{
+ eassert (finalizer->prev == NULL);
+ eassert (finalizer->next == NULL);
+ finalizer->next = element;
+ finalizer->prev = element->prev;
+ finalizer->prev->next = finalizer;
+ element->prev = finalizer;
+}
+
+static void
+unchain_finalizer (struct Lisp_Finalizer *finalizer)
+{
+ if (finalizer->prev != NULL)
+ {
+ eassert (finalizer->next != NULL);
+ finalizer->prev->next = finalizer->next;
+ finalizer->next->prev = finalizer->prev;
+ finalizer->prev = finalizer->next = NULL;
+ }
+}
+
+static void
+mark_finalizer_list (struct Lisp_Finalizer *head)
+{
+ for (struct Lisp_Finalizer *finalizer = head->next;
+ finalizer != head;
+ finalizer = finalizer->next)
+ {
+ finalizer->base.gcmarkbit = true;
+ mark_object (finalizer->function);
+ }
+}
+
+/* Move doomed finalizers to list DEST from list SRC. A doomed
+ finalizer is one that is not GC-reachable and whose
+ finalizer->function is non-nil. */
+
+static void
+queue_doomed_finalizers (struct Lisp_Finalizer *dest,
+ struct Lisp_Finalizer *src)
+{
+ struct Lisp_Finalizer *finalizer = src->next;
+ while (finalizer != src)
+ {
+ struct Lisp_Finalizer *next = finalizer->next;
+ if (!finalizer->base.gcmarkbit && !NILP (finalizer->function))
+ {
+ unchain_finalizer (finalizer);
+ finalizer_insert (dest, finalizer);
+ }
+
+ finalizer = next;
+ }
+}
+
+static Lisp_Object
+run_finalizer_handler (Lisp_Object args)
+{
+ add_to_log ("finalizer failed: %S", args, Qnil);
+ return Qnil;
+}
+
+static void
+run_finalizer_function (Lisp_Object function)
+{
+ struct gcpro gcpro1;
+ ptrdiff_t count = SPECPDL_INDEX ();
+
+ GCPRO1 (function);
+ specbind (Qinhibit_quit, Qt);
+ internal_condition_case_1 (call0, function, Qt, run_finalizer_handler);
+ unbind_to (count, Qnil);
+ UNGCPRO;
+}
+
+static void
+run_finalizers (struct Lisp_Finalizer *finalizers)
+{
+ struct Lisp_Finalizer *finalizer;
+ Lisp_Object function;
+
+ while (finalizers->next != finalizers)
+ {
+ finalizer = finalizers->next;
+ eassert (finalizer->base.type == Lisp_Misc_Finalizer);
+ unchain_finalizer (finalizer);
+ function = finalizer->function;
+ if (!NILP (function))
+ {
+ finalizer->function = Qnil;
+ run_finalizer_function (function);
+ }
+ }
+}
+
+DEFUN ("make-finalizer", Fmake_finalizer, Smake_finalizer, 1, 1, 0,
+ doc: /* Make a finalizer that will run FUNCTION.
+FUNCTION will be called after garbage collection when the returned
+finalizer object becomes unreachable. If the finalizer object is
+reachable only through references from finalizer objects, it does not
+count as reachable for the purpose of deciding whether to run
+FUNCTION. FUNCTION will be run once per finalizer object. */)
+ (Lisp_Object function)
+{
+ Lisp_Object val = allocate_misc (Lisp_Misc_Finalizer);
+ struct Lisp_Finalizer *finalizer = XFINALIZER (val);
+ finalizer->function = function;
+ finalizer->prev = finalizer->next = NULL;
+ finalizer_insert (&finalizers, finalizer);
+ return val;
+}
\f
/************************************************************************
#endif
/* Mark Lisp objects referenced from the address range START+OFFSET..END
- or END+OFFSET..START. */
+ or END+OFFSET..START. */
static void ATTRIBUTE_NO_SANITIZE_ADDRESS
mark_memory (void *start, void *end)
return new;
}
-
DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
doc: /* Make a copy of object OBJ in pure storage.
Recursively copies contents of vectors and cons cells.
else if (FLOATP (obj))
obj = make_pure_float (XFLOAT_DATA (obj));
else if (STRINGP (obj))
- obj = make_pure_string (SSDATA (obj), SCHARS (obj),
- SBYTES (obj),
- STRING_MULTIBYTE (obj));
- else if (COMPILEDP (obj) || VECTORP (obj))
{
- register struct Lisp_Vector *vec;
+ if (XSTRING (obj)->intervals)
+ message ("Dropping text-properties when making string pure");
+ obj = make_pure_string (SSDATA (obj), SCHARS (obj),
+ SBYTES (obj),
+ STRING_MULTIBYTE (obj));
+ }
+ else if (COMPILEDP (obj) || VECTORP (obj) || HASH_TABLE_P (obj))
+ {
+ struct Lisp_Vector *objp = XVECTOR (obj);
+ ptrdiff_t nbytes = vector_nbytes (objp);
+ struct Lisp_Vector *vec = pure_alloc (nbytes, Lisp_Vectorlike);
register ptrdiff_t i;
- ptrdiff_t size;
-
- size = ASIZE (obj);
+ ptrdiff_t size = ASIZE (obj);
if (size & PSEUDOVECTOR_FLAG)
size &= PSEUDOVECTOR_SIZE_MASK;
- vec = XVECTOR (make_pure_vector (size));
+ memcpy (vec, objp, nbytes);
for (i = 0; i < size; i++)
- vec->contents[i] = purecopy (AREF (obj, i));
- if (COMPILEDP (obj))
- {
- XSETPVECTYPE (vec, PVEC_COMPILED);
- XSETCOMPILED (obj, vec);
- }
- else
- XSETVECTOR (obj, vec);
+ vec->contents[i] = purecopy (vec->contents[i]);
+ XSETVECTOR (obj, vec);
}
else if (SYMBOLP (obj))
{
XSYMBOL (obj)->pinned = true;
symbol_block_pinned = symbol_block;
}
+ /* Don't hash-cons it. */
return obj;
}
else
mark_stack (end);
#endif
- /* Everything is now marked, except for the data in font caches
- and undo lists. They're compacted by removing an items which
- aren't reachable otherwise. */
+ /* Everything is now marked, except for the data in font caches,
+ undo lists, and finalizers. The first two are compacted by
+ removing an items which aren't reachable otherwise. */
compact_font_caches ();
mark_object (BVAR (nextb, undo_list));
}
+ /* Now pre-sweep finalizers. Here, we add any unmarked finalizers
+ to doomed_finalizers so we can run their associated functions
+ after GC. It's important to scan finalizers at this stage so
+ that we can be sure that unmarked finalizers are really
+ unreachable except for references from their associated functions
+ and from other finalizers. */
+
+ queue_doomed_finalizers (&doomed_finalizers, &finalizers);
+ mark_finalizer_list (&doomed_finalizers);
+
gc_sweep ();
/* Clear the mark bits that we set in certain root slots. */
}
#endif
+ /* GC is complete: now we can run our finalizer callbacks. */
+ run_finalizers (&doomed_finalizers);
+
if (!NILP (Vpost_gc_hook))
{
ptrdiff_t gc_count = inhibit_garbage_collection ();
void
mark_object (Lisp_Object arg)
{
- register Lisp_Object obj = arg;
+ register Lisp_Object obj;
void *po;
#ifdef GC_CHECK_MARKED_OBJECTS
struct mem_node *m;
#endif
ptrdiff_t cdr_count = 0;
+ obj = arg;
loop:
po = XPNTR (obj);
case Lisp_Misc_Overlay:
mark_overlay (XOVERLAY (obj));
- break;
+ break;
+
+ case Lisp_Misc_Finalizer:
+ XMISCANY (obj)->gcmarkbit = true;
+ mark_object (XFINALIZER (obj)->function);
+ break;
default:
emacs_abort ();
total_free_symbols = num_free;
}
-NO_INLINE /* For better stack traces */
+NO_INLINE /* For better stack traces. */
static void
sweep_misc (void)
{
{
if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker)
unchain_marker (&mblk->markers[i].m.u_marker);
+ if (mblk->markers[i].m.u_any.type == Lisp_Misc_Finalizer)
+ unchain_finalizer (&mblk->markers[i].m.u_finalizer);
/* 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. */
{
/* Even though Qt's contents are not set up, its address is known. */
Vpurify_flag = Qt;
+ gc_precise = (GC_MARK_STACK == GC_USE_GCPROS_AS_BEFORE);
purebeg = PUREBEG;
pure_size = PURESIZE;
verify_alloca ();
+ init_finalizer_list (&finalizers);
+ init_finalizer_list (&doomed_finalizers);
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
mem_init ();
doc: /* Accumulated time elapsed in garbage collections.
The time is in seconds as a floating point value. */);
DEFVAR_INT ("gcs-done", gcs_done,
- doc: /* Accumulated number of garbage collections done. */);
+ doc: /* Accumulated number of garbage collections done. */);
+
+ DEFVAR_BOOL ("gc-precise", gc_precise,
+ doc: /* Non-nil means GC stack marking is precise.
+Useful mainly for automated GC tests. Build time constant.*/);
+ XSYMBOL (intern_c_string ("gc-precise"))->constant = 1;
defsubr (&Scons);
defsubr (&Slist);
defsubr (&Smake_bool_vector);
defsubr (&Smake_symbol);
defsubr (&Smake_marker);
+ defsubr (&Smake_finalizer);
defsubr (&Spurecopy);
defsubr (&Sgarbage_collect);
defsubr (&Smemory_limit);
if (!bidi_initialized)
emacs_abort ();
+ if (ch < 0)
+ {
+ eassert (ch == BIDI_EOB);
+ return false;
+ }
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
#include "keymap.h"
#include "frame.h"
-#ifdef HAVE_XWIDGETS
-#include "xwidget.h"
-#endif /* HAVE_XWIDGETS */
#ifdef WINDOWSNT
#include "w32heap.h" /* for mmap_* */
#endif
kill_buffer_processes (buffer);
UNGCPRO;
-#ifdef HAVE_XWIDGETS
- GCPRO1 (buffer);
- kill_buffer_xwidgets (buffer);
- UNGCPRO;
-#endif /* HAVE_XWIDGETS */
/* Killing buffer processes may run sentinels which may have killed
our buffer. */
if (!BUFFER_LIVE_P (b))
DEFSYM (Qoverwrite_mode, "overwrite-mode");
Fput (Qoverwrite_mode, Qchoice,
list3 (Qnil, intern ("overwrite-mode-textual"),
- intern ("overwrite-mode-binary")));
+ Qoverwrite_mode_binary));
Fput (Qprotected_field, Qerror_conditions,
listn (CONSTYPE_PURE, 2, Qprotected_field, Qerror));
See the command `transient-mark-mode' for a description of this minor mode.
Non-nil also enables highlighting of the region whenever the mark is active.
+The region is highlighted with the `region' face.
The variable `highlight-nonselected-windows' controls whether to highlight
all windows or just the selected window.
defsubr (&Soverlay_get);
defsubr (&Soverlay_put);
defsubr (&Srestore_buffer_modified_p);
+
+ Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
}
void
{
initial_define_key (control_x_map, 'b', "switch-to-buffer");
initial_define_key (control_x_map, 'k', "kill-buffer");
-
- /* This must not be in syms_of_buffer, because Qdisabled is not
- initialized when that function gets called. */
- Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
}
/* Actually this is Bstack_ref with offset 0, but we use Bdup
for that instead. */
/* CASE (Bstack_ref): */
- call3 (intern ("error"),
- build_string ("Invalid byte opcode: op=%s, ptr=%d"),
- make_number (op),
- make_number ((stack.pc - 1) - stack.byte_string_start));
+ call3 (Qerror,
+ build_string ("Invalid byte opcode: op=%s, ptr=%d"),
+ make_number (op),
+ make_number ((stack.pc - 1) - stack.byte_string_start));
/* Handy byte-codes for lexical binding. */
CASE (Bstack_ref1):
args[i] = Fcurrent_buffer ();
if (EQ (selected_window, minibuf_window))
args[i] = Fother_buffer (args[i], Qnil, Qnil);
- args[i] = Fread_buffer (callint_message, args[i], Qt);
+ args[i] = Fread_buffer (callint_message, args[i], Qt, Qnil);
break;
case 'B': /* Name of buffer, possibly nonexistent. */
args[i] = Fread_buffer (callint_message,
Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
- Qnil);
+ Qnil, Qnil);
break;
case 'c': /* Character. */
{
Lisp_Object tem2;
- teml = Fget (teml, intern ("event-symbol-elements"));
+ teml = Fget (teml, Qevent_symbol_elements);
/* Ignore first element, which is the base key. */
- tem2 = Fmemq (intern ("down"), Fcdr (teml));
+ tem2 = Fmemq (Qdown, Fcdr (teml));
if (! NILP (tem2))
up_event = Fread_event (Qnil, Qnil, Qnil);
}
{
Lisp_Object tem2;
- teml = Fget (teml, intern ("event-symbol-elements"));
+ teml = Fget (teml, Qevent_symbol_elements);
/* Ignore first element, which is the base key. */
- tem2 = Fmemq (intern ("down"), Fcdr (teml));
+ tem2 = Fmemq (Qdown, Fcdr (teml));
if (! NILP (tem2))
up_event = Fread_event (Qnil, Qnil, Qnil);
}
specbind (intern ("coding-system-for-write"), val);
/* POSIX lets mk[s]temp use "."; don't invoke jka-compr if we
happen to get a ".Z" suffix. */
- specbind (intern ("file-name-handler-alist"), Qnil);
+ specbind (Qfile_name_handler_alist, Qnil);
write_region (start, end, filename_string, Qnil, Qlambda, Qnil, Qnil, fd);
unbind_to (count1, Qnil);
#ifdef emacs
+/* Return 'true' if C is an alphabetic character as defined by its
+ Unicode properties. */
+bool
+alphabeticp (int c)
+{
+ Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c);
+ if (! INTEGERP (category))
+ return false;
+ EMACS_INT gen_cat = XINT (category);
+
+ /* See UTS #18. There are additional characters that should be
+ here, those designated as Other_uppercase, Other_lowercase,
+ and Other_alphabetic; FIXME. */
+ return (gen_cat == UNICODE_CATEGORY_Lu
+ || gen_cat == UNICODE_CATEGORY_Ll
+ || gen_cat == UNICODE_CATEGORY_Lt
+ || gen_cat == UNICODE_CATEGORY_Lm
+ || gen_cat == UNICODE_CATEGORY_Lo
+ || gen_cat == UNICODE_CATEGORY_Mn
+ || gen_cat == UNICODE_CATEGORY_Mc
+ || gen_cat == UNICODE_CATEGORY_Me
+ || gen_cat == UNICODE_CATEGORY_Nl);
+}
+
+/* Return 'true' if C is an decimal-number character as defined by its
+ Unicode properties. */
+bool
+decimalnump (int c)
+{
+ Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c);
+ if (! INTEGERP (category))
+ return false;
+ EMACS_INT gen_cat = XINT (category);
+
+ /* See UTS #18. */
+ return gen_cat == UNICODE_CATEGORY_Nd;
+}
+
void
syms_of_character (void)
{
extern Lisp_Object Vchar_unify_table;
extern Lisp_Object string_escape_byte8 (Lisp_Object);
+extern bool alphabeticp (int);
+extern bool decimalnump (int);
+
/* Return a translation table of id number ID. */
#define GET_TRANSLATION_TABLE(id) \
(XCDR (XVECTOR (Vtranslation_table_vector)->contents[(id)]))
args[charset_arg_plist] =
listn (CONSTYPE_HEAP, 14,
- intern_c_string (":name"),
+ QCname,
args[charset_arg_name],
intern_c_string (":dimension"),
args[charset_arg_dimension],
args[charset_arg_iso_final],
intern_c_string (":emacs-mule-id"),
args[charset_arg_emacs_mule_id],
- intern_c_string (":ascii-compatible-p"),
+ QCascii_compatible_p,
args[charset_arg_ascii_compatible_p],
intern_c_string (":code-offset"),
args[charset_arg_code_offset]);
Lisp_Object plist[] =
{
- intern_c_string (":name"),
+ QCname,
args[coding_arg_name] = Qno_conversion,
- intern_c_string (":mnemonic"),
+ QCmnemonic,
args[coding_arg_mnemonic] = make_number ('='),
intern_c_string (":coding-type"),
args[coding_arg_coding_type] = Qraw_text,
- intern_c_string (":ascii-compatible-p"),
+ QCascii_compatible_p,
args[coding_arg_ascii_compatible_p] = Qt,
- intern_c_string (":default-char"),
+ QCdefault_char,
args[coding_arg_default_char] = make_number (0),
intern_c_string (":for-unibyte"),
args[coding_arg_for_unibyte] = Qt,
case Lisp_Misc_Overlay:
return Qoverlay;
case Lisp_Misc_Float:
- return Qfloat;
+ return Qfloat;
+ case Lisp_Misc_Finalizer:
+ return Qfinalizer;
}
emacs_abort ();
doc: /* Return the function at the end of OBJECT's function chain.
If OBJECT is not a symbol, just return it. Otherwise, follow all
function indirections to find the final function binding and return it.
-If the final symbol in the chain is unbound, signal a void-function error.
-Optional arg NOERROR non-nil means to return nil instead of signaling.
Signal a cyclic-function-indirection error if there is a loop in the
function chain of symbols. */)
(register Lisp_Object object, Lisp_Object noerror)
if (!NILP (result))
return result;
- if (NILP (noerror))
- xsignal1 (Qvoid_function, object);
-
return Qnil;
}
\f
DEFSYM (Qcons, "cons");
DEFSYM (Qmarker, "marker");
DEFSYM (Qoverlay, "overlay");
+ DEFSYM (Qfinalizer, "finalizer");
DEFSYM (Qfloat, "float");
DEFSYM (Qwindow_configuration, "window-configuration");
DEFSYM (Qprocess, "process");
/* Glyph is a space of fractional width and/or height. */
STRETCH_GLYPH
-#ifdef HAVE_XWIDGETS
- /* Glyph is an external widget drawn by the GUI toolkit. */
- ,XWIDGET_GLYPH
-#endif
};
/* Image ID for image glyphs (type == IMAGE_GLYPH). */
int img_id;
-#ifdef HAVE_XWIDGETS
- struct xwidget* xwidget;
-#endif
/* Sub-structure for type == STRETCH_GLYPH. */
struct
{
/* True means the background of this string has been drawn. */
bool_bf background_filled_p : 1;
- /* True means glyph string must be drawn with 16-bit functions. */
- bool_bf two_byte_p : 1;
-
/* True means that the original font determined for drawing this glyph
string could not be loaded. The member `font' has been set to
the frame's default font in this case. */
/* Image, if any. */
struct image *img;
-#ifdef HAVE_XWIDGETS
- struct xwidget* xwidget;
-#endif
/* Slice */
struct glyph_slice slice;
((FACE) == (FACE)->ascii_face)
/* Return the id of the realized face on frame F that is like the face
- with id ID but is suitable for displaying character CHAR.
- This macro is only meaningful for multibyte character CHAR. */
+ FACE, but is suitable for displaying character CHAR at buffer or
+ string position POS. OBJECT is the string object, or nil for
+ buffer. This macro is only meaningful for multibyte character
+ CHAR. */
#define FACE_FOR_CHAR(F, FACE, CHAR, POS, OBJECT) \
face_for_char ((F), (FACE), (CHAR), (POS), (OBJECT))
/* Continuation glyphs. See the comment for IT_TRUNCATION. */
IT_CONTINUATION
-
-#ifdef HAVE_XWIDGETS
- ,IT_XWIDGET
-#endif
};
GET_FROM_C_STRING,
GET_FROM_IMAGE,
GET_FROM_STRETCH,
-#ifdef HAVE_XWIDGETS
- GET_FROM_XWIDGET,
-#endif
NUM_IT_METHODS
};
struct {
Lisp_Object object;
} stretch;
-#ifdef HAVE_XWIDGETS
- /* method == GET_FROM_XWIDGET */
- struct {
- Lisp_Object object;
- } xwidget;
-#endif
} u;
/* Current text and display positions. */
/* If what == IT_IMAGE, the id of the image to display. */
ptrdiff_t image_id;
-#ifdef HAVE_XWIDGETS
- /* If what == IT_XWIDGET*/
- struct xwidget* xwidget;
-#endif
/* Values from `slice' property. */
struct it_slice slice;
struct glyph_row *, int);
int line_bottom_y (struct it *);
int default_line_pixel_height (struct window *);
-int display_prop_intangible_p (Lisp_Object, Lisp_Object, ptrdiff_t, ptrdiff_t);
+bool 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);
+bool resize_mini_window (struct window *, bool);
void set_vertical_scroll_bar (struct window *);
void set_horizontal_scroll_bar (struct window *);
int try_window (Lisp_Object, struct text_pos, int);
int estimate_mode_line_height (struct frame *, enum face_id);
int move_it_to (struct it *, ptrdiff_t, int, int, int, int);
void pixel_to_glyph_coords (struct frame *, int, int, int *, int *,
- NativeRectangle *, int);
+ NativeRectangle *, bool);
void remember_mouse_glyph (struct frame *, int, int, NativeRectangle *);
-void mark_window_display_accurate (Lisp_Object, int);
+void mark_window_display_accurate (Lisp_Object, bool);
void redisplay_preserve_echo_area (int);
void init_iterator (struct it *, struct window *, ptrdiff_t,
ptrdiff_t, struct glyph_row *, enum face_id);
extern Lisp_Object lookup_glyphless_char_display (int, struct it *);
extern ptrdiff_t compute_display_string_pos (struct text_pos *,
struct bidi_string_data *,
- struct window *, int, int *);
+ struct window *, bool, int *);
extern ptrdiff_t compute_display_string_end (ptrdiff_t,
struct bidi_string_data *);
extern void produce_stretch_glyph (struct it *);
extern Lisp_Object find_hot_spot (Lisp_Object, int, int);
extern void handle_tool_bar_click (struct frame *,
- int, int, int, int);
+ int, int, bool, int);
extern void expose_frame (struct frame *, int, int, int, int);
-extern int x_intersect_rectangles (XRectangle *, XRectangle *,
- XRectangle *);
+extern bool x_intersect_rectangles (XRectangle *, XRectangle *, XRectangle *);
#endif /* HAVE_WINDOW_SYSTEM */
extern void note_mouse_highlight (struct frame *, int, int);
extern void x_clear_window_mouse_face (struct window *);
extern void cancel_mouse_face (struct frame *);
-extern int clear_mouse_face (Mouse_HLInfo *);
+extern bool clear_mouse_face (Mouse_HLInfo *);
extern bool cursor_in_mouse_face_p (struct window *w);
extern void tty_draw_row_with_mouse_face (struct window *, struct glyph_row *,
int, int, enum draw_glyphs_face);
-extern void display_tty_menu_item (const char *, int, int, int, int, int);
+extern void display_tty_menu_item (const char *, int, int, int, int, bool);
/* Flags passed to try_window. */
#define TRY_WINDOW_CHECK_MARGINS (1 << 0)
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
-#ifdef HAVE_XWIDGETS
-#include "xwidget.h"
-#endif
-
#include <errno.h>
#include <fpending.h>
for (i = 0; i < matrix->nrows; ++i)
matrix->rows[i].enabled_p = false;
}
+ /* We've disabled the mode-line row, so force redrawing of
+ the mode line, if any, since otherwise it will remain
+ disabled in the current matrix, and expose events won't
+ redraw it. */
+ if (WINDOW_WANTS_MODELINE_P (w))
+ w->update_mode_line = 1;
}
else if (matrix == w->desired_matrix)
{
add_window_display_history (w, w->current_matrix->method, paused_p);
#endif
-#ifdef HAVE_XWIDGETS
- xwidget_end_redisplay(w, w->current_matrix);
-#endif
clear_glyph_matrix (desired_matrix);
return paused_p;
{
cx = cy = vpos = hpos = 0;
- if (cursor_in_echo_area >= 0)
- {
- /* If the mini-buffer is several lines high, find the last
- line that has any text on it. Note: either all lines
- are enabled or none. Otherwise we wouldn't be able to
- determine Y. */
- struct glyph_row *row, *last_row;
- struct glyph *glyph;
- int yb = window_text_bottom_y (w);
-
- last_row = NULL;
- row = w->current_matrix->rows;
- while (row->enabled_p
- && (last_row == NULL
- || MATRIX_ROW_BOTTOM_Y (row) <= yb))
- {
- if (row->used[TEXT_AREA]
- && row->glyphs[TEXT_AREA][0].charpos >= 0)
- last_row = row;
- ++row;
- }
+ /* If the mini-buffer is several lines high, find the last
+ line that has any text on it. Note: either all lines
+ are enabled or none. Otherwise we wouldn't be able to
+ determine Y. */
+ struct glyph_row *last_row = NULL;
+ int yb = window_text_bottom_y (w);
- if (last_row)
- {
- struct glyph *start = last_row->glyphs[TEXT_AREA];
- struct glyph *last = start + last_row->used[TEXT_AREA] - 1;
+ for (struct glyph_row *row = w->current_matrix->rows;
+ row->enabled_p && (!last_row || MATRIX_ROW_BOTTOM_Y (row) <= yb);
+ row++)
+ if (row->used[TEXT_AREA] && row->glyphs[TEXT_AREA][0].charpos >= 0)
+ last_row = row;
- while (last > start && last->charpos < 0)
- --last;
+ if (last_row)
+ {
+ struct glyph *start = last_row->glyphs[TEXT_AREA];
+ struct glyph *last = start + last_row->used[TEXT_AREA] - 1;
- for (glyph = start; glyph < last; ++glyph)
- {
- cx += glyph->pixel_width;
- ++hpos;
- }
+ while (last > start && last->charpos < 0)
+ --last;
- cy = last_row->y;
- vpos = MATRIX_ROW_VPOS (last_row, w->current_matrix);
+ for (struct glyph *glyph = start; glyph < last; glyph++)
+ {
+ cx += glyph->pixel_width;
+ hpos++;
}
+
+ cy = last_row->y;
+ vpos = MATRIX_ROW_VPOS (last_row, w->current_matrix);
}
}
else
break;
}
-#ifdef HAVE_XWIDGETS
- //currently this is needed to detect xwidget movement reliably. or probably not.
- return 0;
-#endif
-
/* Give up if some rows in the desired matrix are not enabled. */
if (! MATRIX_ROW_ENABLED_P (desired_matrix, i))
return -1;
&& EQ (FRAME_MINIBUF_WINDOW (f), echo_area_window))
{
int top = WINDOW_TOP_EDGE_LINE (XWINDOW (FRAME_MINIBUF_WINDOW (f)));
- int row, col;
+ int col;
- if (cursor_in_echo_area < 0)
+ /* Put cursor at the end of the prompt. If the mini-buffer
+ is several lines high, find the last line that has
+ any text on it. */
+ int row = FRAME_TOTAL_LINES (f);
+ do
{
- /* Negative value of cursor_in_echo_area means put
- cursor at beginning of line. */
- row = top;
+ row--;
col = 0;
- }
- else
- {
- /* Positive value of cursor_in_echo_area means put
- cursor at the end of the prompt. If the mini-buffer
- is several lines high, find the last line that has
- any text on it. */
- row = FRAME_TOTAL_LINES (f);
- do
- {
- --row;
- col = 0;
- if (MATRIX_ROW_ENABLED_P (current_matrix, row))
- {
- /* Frame rows are filled up with spaces that
- must be ignored here. */
- struct glyph_row *r = MATRIX_ROW (current_matrix,
- row);
- struct glyph *start = r->glyphs[TEXT_AREA];
- struct glyph *last = start + r->used[TEXT_AREA];
-
- while (last > start
- && (last - 1)->charpos < 0)
- --last;
-
- col = last - start;
- }
+ if (MATRIX_ROW_ENABLED_P (current_matrix, row))
+ {
+ /* Frame rows are filled up with spaces that
+ must be ignored here. */
+ struct glyph_row *r = MATRIX_ROW (current_matrix, row);
+ struct glyph *start = r->glyphs[TEXT_AREA];
+
+ col = r->used[TEXT_AREA];
+ while (0 < col && start[col - 1].charpos < 0)
+ col--;
}
- while (row > top && col == 0);
+ }
+ while (row > top && col == 0);
- /* Make sure COL is not out of range. */
- if (col >= FRAME_CURSOR_X_LIMIT (f))
+ /* Make sure COL is not out of range. */
+ if (col >= FRAME_CURSOR_X_LIMIT (f))
+ {
+ /* If we have another row, advance cursor into it. */
+ if (row < FRAME_TOTAL_LINES (f) - 1)
{
- /* If we have another row, advance cursor into it. */
- if (row < FRAME_TOTAL_LINES (f) - 1)
- {
- col = FRAME_LEFT_SCROLL_BAR_COLS (f);
- row++;
- }
- /* Otherwise move it back in range. */
- else
- col = FRAME_CURSOR_X_LIMIT (f) - 1;
+ col = FRAME_LEFT_SCROLL_BAR_COLS (f);
+ row++;
}
+ /* Otherwise move it back in range. */
+ else
+ col = FRAME_CURSOR_X_LIMIT (f) - 1;
}
cursor_to (f, row, col);
space_glyph.charpos = -1;
inverse_video = 0;
- cursor_in_echo_area = 0;
+ cursor_in_echo_area = false;
/* Now is the time to initialize this; it's used by init_sys_modes
during startup. */
}
#endif /* SIGWINCH */
- /* If running as a daemon, no need to initialize any frames/terminal. */
+ /* If running as a daemon, no need to initialize any frames/terminal,
+ except on Windows, where we at least want to initialize it. */
+#ifndef WINDOWSNT
if (IS_DAEMON)
return;
+#endif
/* If the user wants to use a window system, we shouldn't bother
initializing the terminal. This is especially important when the
{
return make_save_obj_obj_obj_obj
(Fpoint_marker (),
- /* Do not copy the mark if it points to nowhere. */
- (XMARKER (BVAR (current_buffer, mark))->buffer
- ? Fcopy_marker (BVAR (current_buffer, mark), Qnil)
- : Qnil),
+ Qnil,
/* Selected window if current buffer is shown in it, nil otherwise. */
(EQ (XWINDOW (selected_window)->contents, Fcurrent_buffer ())
? selected_window : Qnil),
- BVAR (current_buffer, mark_active));
+ Qnil);
}
/* Restore saved buffer before leaving `save-excursion' special form. */
void
save_excursion_restore (Lisp_Object info)
{
- Lisp_Object tem, tem1, omark, nmark;
- struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object tem, tem1;
+ struct gcpro gcpro1;
tem = Fmarker_buffer (XSAVE_OBJECT (info, 0));
/* If we're unwinding to top level, saved buffer may be deleted. This
if (NILP (tem))
goto out;
- omark = nmark = Qnil;
- GCPRO3 (info, omark, nmark);
+ GCPRO1 (info);
Fset_buffer (tem);
Fgoto_char (tem);
unchain_marker (XMARKER (tem));
- /* Mark marker. */
- tem = XSAVE_OBJECT (info, 1);
- omark = Fmarker_position (BVAR (current_buffer, mark));
- if (NILP (tem))
- unchain_marker (XMARKER (BVAR (current_buffer, mark)));
- else
- {
- Fset_marker (BVAR (current_buffer, mark), tem, Fcurrent_buffer ());
- nmark = Fmarker_position (tem);
- unchain_marker (XMARKER (tem));
- }
-
- /* Mark active. */
- tem = XSAVE_OBJECT (info, 3);
- tem1 = BVAR (current_buffer, mark_active);
- 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. */
- if (! NILP (tem))
- {
- if (! EQ (omark, nmark))
- run_hook (intern ("activate-mark-hook"));
- }
- /* If mark has ceased to be active, run deactivate hook. */
- else if (! NILP (tem1))
- run_hook (intern ("deactivate-mark-hook"));
-
/* If buffer was visible in a window, and a different window was
selected, and the old selected window is still showing this
buffer, restore point in that window. */
}
DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0,
- doc: /* Save point, mark, and current buffer; execute BODY; restore those things.
+ doc: /* Save point, and current buffer; execute BODY; restore those things.
Executes BODY just like `progn'.
-The values of point, mark and the current buffer are restored
+The values of point and the current buffer are restored
even in case of abnormal exit (throw or error).
-The state of activation of the mark is also restored.
-This construct does not save `deactivate-mark', and therefore
-functions that change the buffer will still cause deactivation
-of the mark at the end of the command. To prevent that, bind
-`deactivate-mark' with `let'.
-
-If you only want to save the current buffer but not point nor mark,
+If you only want to save the current buffer but not point,
then just use `save-current-buffer', or even `with-current-buffer'.
usage: (save-excursion &rest BODY) */)
/* Set up the user name info if we didn't do it before.
(That can happen if Emacs is dumpable
but you decide to run `temacs -l loadup' and not dump. */
- if (INTEGERP (Vuser_login_name))
+ if (NILP (Vuser_login_name))
init_editfns ();
if (NILP (uid))
/* Set up the user name info if we didn't do it before.
(That can happen if Emacs is dumpable
but you decide to run `temacs -l loadup' and not dump. */
- if (INTEGERP (Vuser_login_name))
+ if (NILP (Vuser_login_name))
init_editfns ();
return Vuser_real_login_name;
}
error ("Invalid time specification");
}
+/* Check a return value compatible with that of decode_time_components. */
+static void
+check_time_validity (int validity)
+{
+ if (validity <= 0)
+ {
+ if (validity < 0)
+ time_overflow ();
+ else
+ invalid_time ();
+ }
+}
+
/* A substitute for mktime_z on platforms that lack it. It's not
thread-safe, but should be good enough for Emacs in typical use. */
#ifndef HAVE_TZALLOC
-time_t
+static time_t
mktime_z (timezone_t tz, struct tm *tm)
{
char *oldtz = getenv ("TZ");
If *DRESULT is not null, store into *DRESULT the number of
seconds since the start of the POSIX Epoch.
- Return true if successful, false if the components are of the
- wrong type or represent a time out of range. */
-bool
+ Return 1 if successful, 0 if the components are of the
+ wrong type, and -1 if the time is out of range. */
+int
decode_time_components (Lisp_Object high, Lisp_Object low, Lisp_Object usec,
Lisp_Object psec,
struct lisp_time *result, double *dresult)
EMACS_INT hi, lo, us, ps;
if (! (INTEGERP (high)
&& INTEGERP (usec) && INTEGERP (psec)))
- return false;
+ return 0;
if (! INTEGERP (low))
{
if (FLOATP (low))
{
double t = XFLOAT_DATA (low);
if (result && ! decode_float_time (t, result))
- return false;
+ return -1;
if (dresult)
*dresult = t;
- return true;
+ return 1;
}
else if (NILP (low))
{
}
if (dresult)
*dresult = now.tv_sec + now.tv_nsec / 1e9;
- return true;
+ return 1;
}
else
- return false;
+ return 0;
}
hi = XINT (high);
if (result)
{
if (! (MOST_NEGATIVE_FIXNUM <= hi && hi <= MOST_POSITIVE_FIXNUM))
- return false;
+ return -1;
result->hi = hi;
result->lo = lo;
result->us = us;
*dresult = (us * 1e6 + ps) / 1e12 + lo + dhi * (1 << LO_TIME_BITS);
}
- return true;
+ return 1;
}
struct timespec
Lisp_Object high, low, usec, psec;
struct lisp_time t;
int len = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec);
- if (! (len && decode_time_components (high, low, usec, psec, &t, 0)))
- invalid_time ();
+ int val = len ? decode_time_components (high, low, usec, psec, &t, 0) : 0;
+ check_time_validity (val);
*plen = len;
return t;
}
{
Lisp_Object high, low, usec, psec;
struct lisp_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)))
- invalid_time ();
- if (! ((TYPE_SIGNED (time_t) ? TIME_T_MIN >> LO_TIME_BITS <= t.hi : 0 <= t.hi)
- && t.hi <= TIME_T_MAX >> LO_TIME_BITS))
- time_overflow ();
+
+ int val = disassemble_lisp_time (specified_time, &high, &low, &usec, &psec);
+ if (val != 0)
+ {
+ val = decode_time_components (high, low, make_number (0),
+ make_number (0), &t, 0);
+ if (0 < val
+ && ! ((TYPE_SIGNED (time_t)
+ ? TIME_T_MIN >> LO_TIME_BITS <= t.hi
+ : 0 <= t.hi)
+ && t.hi <= TIME_T_MAX >> LO_TIME_BITS))
+ val = -1;
+ }
+ check_time_validity (val);
return (t.hi << LO_TIME_BITS) + t.lo;
}
/* Do this here, because init_buffer_once is too early--it won't work. */
Fset_buffer (Vprin1_to_string_buffer);
/* Make sure buffer-access-fontify-functions is nil in this buffer. */
- Fset (Fmake_local_variable (intern_c_string ("buffer-access-fontify-functions")),
- Qnil);
+ Fset (Fmake_local_variable (Qbuffer_access_fontify_functions), Qnil);
Fset_buffer (obuf);
}
DEFVAR_LISP ("user-login-name", Vuser_login_name,
doc: /* The user's name, taken from environment variables if possible. */);
+ Vuser_login_name = Qnil;
DEFVAR_LISP ("user-real-login-name", Vuser_real_login_name,
doc: /* The user's name, based upon the real uid only. */);
#include "buffer.h"
#include "window.h"
-#ifdef HAVE_XWIDGETS
-#include "xwidget.h"
-#endif
#include "systty.h"
#include "atimer.h"
#include "blockinput.h"
/* Name for the server started by the daemon.*/
static char *daemon_name;
+#ifndef WINDOWSNT
/* Pipe used to send exit notification to the daemon parent at
startup. */
int daemon_pipe[2];
+#else
+HANDLE w32_daemon_event;
+#endif
/* Save argv and argc. */
char **initial_argv;
--no-init-file, -q load neither ~/.emacs nor default.el\n\
--no-loadup, -nl do not load loadup.el into bare Emacs\n\
--no-site-file do not load site-start.el\n\
+--no-x-resources do not load X resources\n\
--no-site-lisp, -nsl do not add site-lisp directories to load-path\n\
--no-splash do not display a splash screen on startup\n\
--no-window-system, -nw do not communicate with X, ignoring $DISPLAY\n\
"\
--quick, -Q equivalent to:\n\
-q --no-site-file --no-site-lisp --no-splash\n\
+ --no-x-resources\n\
--script FILE run FILE as an Emacs Lisp script\n\
--terminal, -t DEVICE use DEVICE for terminal I/O\n\
--user, -u USER load ~USER/.emacs instead of your own\n\
terminate_due_to_signal (int sig, int backtrace_limit)
{
signal (sig, SIG_DFL);
- totally_unblock_input ();
/* If fatal error occurs in code below, avoid infinite recursion. */
if (! fatal_error_in_progress)
{
fatal_error_in_progress = 1;
+ totally_unblock_input ();
if (sig == SIGTERM || sig == SIGHUP || sig == SIGINT)
Fkill_emacs (make_number (sig));
clearerr (stdin);
+ emacs_backtrace (-1);
+
#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC
/* Arrange to get warning messages as memory fills up. */
memory_warnings (0, malloc_warning);
exit (0);
}
+#ifndef WINDOWSNT
/* Make sure IS_DAEMON starts up as false. */
daemon_pipe[1] = 0;
+#else
+ w32_daemon_event = NULL;
+#endif
if (argmatch (argv, argc, "-daemon", "--daemon", 5, NULL, &skip_args)
|| argmatch (argv, argc, "-daemon", "--daemon", 5, &dname_arg, &skip_args))
}
#endif /* DAEMON_MUST_EXEC */
- if (dname_arg)
- daemon_name = xstrdup (dname_arg);
/* Close unused reading end of the pipe. */
emacs_close (daemon_pipe[0]);
setsid ();
-#else /* DOS_NT */
+#elif defined(WINDOWSNT)
+ /* Indicate that we want daemon mode. */
+ w32_daemon_event = CreateEvent (NULL, TRUE, FALSE, W32_DAEMON_EVENT);
+ if (w32_daemon_event == NULL)
+ {
+ fprintf (stderr, "Couldn't create MS-Windows event for daemon: %s\n",
+ w32_strerror (0));
+ exit (1);
+ }
+#else /* MSDOS */
fprintf (stderr, "This platform does not support the -daemon flag.\n");
exit (1);
-#endif /* DOS_NT */
+#endif /* MSDOS */
+ if (dname_arg)
+ daemon_name = xstrdup (dname_arg);
}
#if defined HAVE_PTHREAD && !defined SYSTEM_MALLOC \
syms_of_xfns ();
syms_of_xmenu ();
syms_of_fontset ();
-#ifdef HAVE_XWIDGETS
- syms_of_xwidget();
-#endif
syms_of_xsettings ();
#ifdef HAVE_X_SM
syms_of_xsmfns ();
if (filename_from_ansi (file, file_utf8) == 0)
file = file_utf8;
#endif
- Vtop_level = list2 (intern_c_string ("load"),
- build_unibyte_string (file));
+ Vtop_level = list2 (Qload, build_unibyte_string (file));
}
/* Unless next switch is -nl, load "loadup.el" first thing. */
if (! no_loadup)
- Vtop_level = list2 (intern_c_string ("load"),
- build_string ("loadup.el"));
+ Vtop_level = list2 (Qload, build_string ("loadup.el"));
}
/* Set up for profiling. This is known to work on FreeBSD,
{ "-quick", 0, 55, 0 },
{ "-q", "--no-init-file", 50, 0 },
{ "-no-init-file", 0, 50, 0 },
+ { "-no-x-resources", "--no-x-resources", 40, 0 },
{ "-no-site-file", "--no-site-file", 40, 0 },
{ "-u", "--user", 30, 1 },
{ "-user", 0, 30, 1 },
GCPRO1 (arg);
- if (feof (stdin))
- arg = Qt;
-
/* Fsignal calls emacs_abort () if it sees that waiting_for_input is
set. */
waiting_for_input = 0;
x_clipboard_manager_save_all ();
#endif
- shut_down_emacs (0, STRINGP (arg) ? arg : Qnil);
+ shut_down_emacs (0, (STRINGP (arg) && !feof (stdin)) ? arg : Qnil);
#ifdef HAVE_NS
ns_release_autorelease_pool (ns_pool);
{
if (! EQ (*plocale, desired_locale))
{
+#ifdef WINDOWSNT
+ /* Changing categories like LC_TIME usually requires to specify
+ an encoding suitable for the new locale, but MS-Windows's
+ 'setlocale' will only switch the encoding when LC_ALL is
+ specified. So we ignore CATEGORY and use LC_ALL instead. */
+ category = LC_ALL;
+#endif
*plocale = desired_locale;
setlocale (category, (STRINGP (desired_locale)
? SSDATA (desired_locale)
p = strchr (path, SEPCHAR);
if (!p)
p = path + strlen (path);
- element = (p - path ? make_unibyte_string (path, p - path)
+ element = ((p - path) ? make_unibyte_string (path, p - path)
: empty_element);
if (! NILP (element))
{
from the parent process and its tty file descriptors. */)
(void)
{
- int nfd;
bool err = 0;
if (!IS_DAEMON)
error ("This function can only be called if emacs is run as a daemon");
- if (daemon_pipe[1] < 0)
+ if (!DAEMON_RUNNING)
error ("The daemon has already been initialized");
if (NILP (Vafter_init_time))
error ("This function can only be called after loading the init files");
+#ifndef WINDOWSNT
+ int nfd;
/* Get rid of stdin, stdout and stderr. */
nfd = emacs_open ("/dev/null", O_RDWR, 0);
err |= emacs_close (daemon_pipe[1]) != 0;
/* Set it to an invalid value so we know we've already run this function. */
daemon_pipe[1] = -1;
+#else /* WINDOWSNT */
+ /* Signal the waiting emacsclient process. */
+ err |= SetEvent (w32_daemon_event) == 0;
+ err |= CloseHandle (w32_daemon_event) == 0;
+ /* Set it to an invalid value so we know we've already run this function. */
+ w32_daemon_event = INVALID_HANDLE_VALUE;
+#endif
if (err)
error ("I/O error during daemon initialization");
#include "lisp.h"
#include "frame.h"
#include "xterm.h"
-#ifdef HAVE_XWIDGETS
-#include "xwidget.h"
-#endif
#include "emacsgtkfixed.h"
/* Silence a bogus diagnostic; see GNOME bug 683906. */
# 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) */
+#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; */
+struct _EmacsFixed
+{
+ GtkFixed container;
-/* /\*< private >*\/ */
-/* EmacsFixedPrivate *priv; */
-/* }; */
+ /*< private >*/
+ EmacsFixedPrivate *priv;
+};
-/* struct _EmacsFixedClass */
-/* { */
-/* GtkFixedClass parent_class; */
-/* }; */
+struct _EmacsFixedClass
+{
+ GtkFixedClass parent_class;
+};
struct _EmacsFixedPrivate
{
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)
-#ifdef HAVE_XWIDGETS
-
-struct GtkFixedPrivateL
-{
- GList *children;
-};
-
-static void emacs_fixed_gtk_widget_size_allocate (GtkWidget *widget,
- GtkAllocation *allocation){
- //for xwidgets
-
- //TODO 1st call base class method
- EmacsFixedClass *klass;
- GtkWidgetClass *parent_class;
- struct GtkFixedPrivateL* priv;
- GtkFixedChild *child;
- GtkAllocation child_allocation;
- GtkRequisition child_requisition;
- GList *children;
- struct xwidget_view* xv;
-
- klass = EMACS_FIXED_GET_CLASS (widget);
- parent_class = g_type_class_peek_parent (klass);
- parent_class->size_allocate (widget, allocation);
-
- priv = G_TYPE_INSTANCE_GET_PRIVATE (widget,
- GTK_TYPE_FIXED,
- struct GtkFixedPrivateL);
-
- gtk_widget_set_allocation (widget, allocation);
-
- if (gtk_widget_get_has_window (widget))
- {
- if (gtk_widget_get_realized (widget))
- gdk_window_move_resize (gtk_widget_get_window (widget),
- allocation->x,
- allocation->y,
- allocation->width,
- allocation->height);
- }
-
- for (children = priv->children;
- children;
- children = children->next)
- {
- child = children->data;
-
- if (!gtk_widget_get_visible (child->widget))
- continue;
-
- gtk_widget_get_preferred_size (child->widget, &child_requisition, NULL);
- child_allocation.x = child->x;
- child_allocation.y = child->y;
-
- if (!gtk_widget_get_has_window (widget))
- {
- child_allocation.x += allocation->x;
- child_allocation.y += allocation->y;
- }
-
- child_allocation.width = child_requisition.width;
- child_allocation.height = child_requisition.height;
-
-
-
- xv = (struct xwidget_view*) g_object_get_data (G_OBJECT (child->widget), XG_XWIDGET_VIEW);
- if(xv){
- child_allocation.width = xv->clip_right;
- child_allocation.height = xv->clip_bottom - xv->clip_top;
- }
- gtk_widget_size_allocate (child->widget, &child_allocation);
-
- }
-
-}
-
-#endif /* HAVE_XWIDGETS */
-
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;
-#ifdef HAVE_XWIDGETS
- widget_class->size_allocate = emacs_fixed_gtk_widget_size_allocate;
-#endif
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)
{
G_BEGIN_DECLS
-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
if (!NILP (Vinternal_interpreter_environment)
&& CONSP (quoted)
&& EQ (XCAR (quoted), Qlambda))
- /* This is a lambda expression within a lexical environment;
- return an interpreted closure instead of a simple lambda. */
- return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment,
- XCDR (quoted)));
+ { /* This is a lambda expression within a lexical environment;
+ return an interpreted closure instead of a simple lambda. */
+ Lisp_Object cdr = XCDR (quoted);
+ Lisp_Object tmp = cdr;
+ if (CONSP (tmp)
+ && (tmp = XCDR (tmp), CONSP (tmp))
+ && (tmp = XCAR (tmp), CONSP (tmp))
+ && (EQ (QCdocumentation, XCAR (tmp))))
+ { /* Handle the special (:documentation <form>) to build the docstring
+ dynamically. */
+ Lisp_Object docstring = eval_sub (Fcar (XCDR (tmp)));
+ CHECK_STRING (docstring);
+ cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr))));
+ }
+ return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment,
+ cdr));
+ }
else
/* Simply quote the argument. */
return quoted;
DEFSYM (Qand_rest, "&rest");
DEFSYM (Qand_optional, "&optional");
DEFSYM (Qclosure, "closure");
+ DEFSYM (QCdocumentation, ":documentation");
DEFSYM (Qdebug, "debug");
DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger,
DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
doc: /* Generate temporary file name (string) starting with PREFIX (a string).
-The Emacs process number forms part of the result,
-so there is no danger of generating a name being used by another process.
+The Emacs process number forms part of the result, so there is no
+danger of generating a name being used by another Emacs process
+\(so long as only a single host can access the containing directory...).
-In addition, this function makes an attempt to choose a name
-which has no existing file. To make this work,
-PREFIX should be an absolute file name.
+This function tries to choose a name that has no existing file.
+For this to work, PREFIX should be an absolute file name.
There is a race condition between calling `make-temp-name' and creating the
-file which opens all kinds of security holes. For that reason, you should
-probably use `make-temp-file' instead, except in three circumstances:
-
-* If you are creating the file in the user's home directory.
-* If you are creating a directory rather than an ordinary file.
-* If you are taking special precautions as `make-temp-file' does. */)
+file, which opens all kinds of security holes. For that reason, you should
+normally use `make-temp-file' instead. */)
(Lisp_Object prefix)
{
return make_temp_name (prefix, 0);
return Fcons (make_float (sgnfcand), make_number (exponent));
}
-DEFUN ("ldexp", Fldexp, Sldexp, 1, 2, 0,
- doc: /* Construct number X from significand SGNFCAND and exponent EXP.
-Returns the floating point value resulting from multiplying SGNFCAND
-(the significand) by 2 raised to the power of EXP (the exponent). */)
+DEFUN ("ldexp", Fldexp, Sldexp, 2, 2, 0,
+ doc: /* Return X * 2**EXP, as a floating point number.
+EXP must be an integer. */)
(Lisp_Object sgnfcand, Lisp_Object exponent)
{
CHECK_NUMBER (exponent);
- return make_float (ldexp (XFLOATINT (sgnfcand), XINT (exponent)));
+ int e = min (max (INT_MIN, XINT (exponent)), INT_MAX);
+ return make_float (ldexp (XFLOATINT (sgnfcand), e));
}
\f
DEFUN ("exp", Fexp, Sexp, 1, 1, 0,
DEFVAR_LISP ("features", Vfeatures,
doc: /* A list of symbols which are the features of the executing Emacs.
Used by `featurep' and `require', and altered by `provide'. */);
- Vfeatures = list1 (intern_c_string ("emacs"));
+ Vfeatures = list1 (Qemacs);
DEFSYM (Qsubfeatures, "subfeatures");
DEFSYM (Qfuncall, "funcall");
}
/* Score the size. Maximum difference is 127. */
- i = FONT_SIZE_INDEX;
if (! NILP (spec_prop[FONT_SIZE_INDEX])
&& XINT (AREF (entity, FONT_SIZE_INDEX)) > 0)
{
expression matching. */
ptrdiff_t regexsize = (SBYTES (pattern)
+ (ndashes < 14 ? 2 : 5) * nstars
- + 2 * nescs + 1);
+ + 2 * nescs + 3);
USE_SAFE_ALLOCA;
p1 = regex = SAFE_ALLOCA (regexsize);
bool frame_garbaged;
/* The default tool bar height for future frames. */
+#if defined USE_GTK || defined HAVE_NS
+enum { frame_default_tool_bar_height = 0 };
+#else
int frame_default_tool_bar_height;
+#endif
#ifdef HAVE_WINDOW_SYSTEM
static void x_report_frame_params (struct frame *, Lisp_Object *);
return Fcdr (tem);
}
+
+void
+frame_size_history_add (struct frame *f, Lisp_Object fun_symbol,
+ int width, int height, Lisp_Object rest)
+{
+ Lisp_Object frame;
+
+ XSETFRAME (frame, f);
+ if (CONSP (frame_size_history)
+ && INTEGERP (XCAR (frame_size_history))
+ && 0 < XINT (XCAR (frame_size_history)))
+ frame_size_history =
+ Fcons (make_number (XINT (XCAR (frame_size_history)) - 1),
+ Fcons (list4
+ (frame, fun_symbol,
+ ((width > 0)
+ ? list4 (make_number (FRAME_TEXT_WIDTH (f)),
+ make_number (FRAME_TEXT_HEIGHT (f)),
+ make_number (width),
+ make_number (height))
+ : Qnil),
+ rest),
+ XCDR (frame_size_history)));
+}
+
+
/* Return 1 if `frame-inhibit-implied-resize' is non-nil or fullscreen
state of frame F would be affected by a vertical (horizontal if
HORIZONTAL is true) resize. PARAMETER is the symbol of the frame
bool
frame_inhibit_resize (struct frame *f, bool horizontal, Lisp_Object parameter)
{
- return (EQ (frame_inhibit_implied_resize, Qt)
- || (CONSP (frame_inhibit_implied_resize)
- && !NILP (Fmemq (parameter, frame_inhibit_implied_resize)))
- || !NILP (get_frame_param (f, Qfullscreen))
- || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f));
+ Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ bool inhibit
+ = ((f->after_make_frame
+ && (EQ (frame_inhibit_implied_resize, Qt)
+ || (CONSP (frame_inhibit_implied_resize)
+ && !NILP (Fmemq (parameter, frame_inhibit_implied_resize)))))
+ || (horizontal
+ && !EQ (fullscreen, Qnil) && !EQ (fullscreen, Qfullheight))
+ || (!horizontal
+ && !EQ (fullscreen, Qnil) && !EQ (fullscreen, Qfullwidth))
+ || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f));
+
+ if (inhibit && !FRAME_TERMCAP_P (f) && !FRAME_MSDOS_P (f))
+ frame_size_history_add
+ (f, Qframe_inhibit_resize, 0, 0,
+ list5 (horizontal ? Qt : Qnil, parameter,
+ f->after_make_frame ? Qt : Qnil,
+ frame_inhibit_implied_resize,
+ fullscreen));
+
+ return inhibit;
}
static void
XSETFRAME (frame, f);
- /* `make-frame' initializes Vframe_adjust_size_history to (Qt) and
- strips its car when exiting. Just in case make sure its size never
- exceeds 100. */
- if (!NILP (Fconsp (Vframe_adjust_size_history))
- && EQ (Fcar (Vframe_adjust_size_history), Qt)
- && XFASTINT (Fsafe_length (Vframe_adjust_size_history)) <= 100)
- Vframe_adjust_size_history =
- Fcons (Qt, Fcons (list5 (make_number (0),
- make_number (new_text_width),
- make_number (new_text_height),
- make_number (inhibit), parameter),
- Fcdr (Vframe_adjust_size_history)));
+ frame_size_history_add
+ (f, Qadjust_frame_size_1, new_text_width, new_text_height,
+ list2 (parameter, make_number (inhibit)));
/* The following two values are calculated from the old window body
sizes and any "new" settings for scroll bars, dividers, fringes and
= frame_windows_min_size (frame, Qnil, (inhibit == 5) ? Qt : Qnil, Qt);
if (inhibit >= 2 && inhibit <= 4)
- /* If INHIBIT is in [2..4] inhibit if the "old" window sizes stay
+ /* When INHIBIT is in [2..4] inhibit if the "old" window sizes stay
within the limits and either frame_inhibit_resize tells us to do
so or INHIBIT equals 4. */
{
else if (inhibit_vertical)
new_text_height = old_text_height;
- if (!NILP (Fconsp (Vframe_adjust_size_history))
- && EQ (Fcar (Vframe_adjust_size_history), Qt)
- && XFASTINT (Fsafe_length (Vframe_adjust_size_history)) <= 100)
- Vframe_adjust_size_history =
- Fcons (Qt, Fcons (list5 (make_number (1),
- make_number (new_text_width),
- make_number (new_text_height),
- make_number (new_cols),
- make_number (new_lines)),
- Fcdr (Vframe_adjust_size_history)));
+ frame_size_history_add
+ (f, Qadjust_frame_size_2, new_text_width, new_text_height,
+ list2 (inhibit_horizontal ? Qt : Qnil,
+ inhibit_vertical ? Qt : Qnil));
x_set_window_size (f, 0, new_text_width, new_text_height, 1);
f->resized_p = true;
}
#endif
}
+ else if (new_cols != old_cols)
+ call2 (Qwindow_pixel_to_total, frame, Qt);
if (new_windows_height != old_windows_height
/* When the top margin has changed we have to recalculate the top
if ((FRAME_TERMCAP_P (f) && !pretend) || FRAME_MSDOS_P (f))
FrameRows (FRAME_TTY (f)) = new_lines + FRAME_TOP_MARGIN (f);
}
+ else if (new_lines != old_lines)
+ call2 (Qwindow_pixel_to_total, frame, Qnil);
+
+ frame_size_history_add
+ (f, Qadjust_frame_size_3, new_text_width, new_text_height,
+ list4 (make_number (old_pixel_width), make_number (old_pixel_height),
+ make_number (new_pixel_width), make_number (new_pixel_height)));
/* Assign new sizes. */
FRAME_TEXT_WIDTH (f) = new_text_width;
SET_FRAME_COLS (f, new_cols);
SET_FRAME_LINES (f, new_lines);
- if (!NILP (Fconsp (Vframe_adjust_size_history))
- && EQ (Fcar (Vframe_adjust_size_history), Qt)
- && XFASTINT (Fsafe_length (Vframe_adjust_size_history)) <= 100)
- Vframe_adjust_size_history =
- Fcons (Qt, Fcons (list5 (make_number (2),
- make_number (new_text_width),
- make_number (new_text_height),
- make_number (new_cols),
- make_number (new_lines)),
- Fcdr (Vframe_adjust_size_history)));
-
{
struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f));
int text_area_x, text_area_y, text_area_width, text_area_height;
f->redisplay = true;
f->garbaged = true;
f->can_x_set_window_size = false;
- f->can_run_window_configuration_change_hook = false;
+ f->after_make_frame = false;
f->tool_bar_redisplayed_once = false;
f->column_width = 1; /* !FRAME_WINDOW_P value. */
f->line_height = 1; /* !FRAME_WINDOW_P value. */
last_nonminibuf_frame = f;
+ f->can_x_set_window_size = true;
+ f->after_make_frame = true;
+
return f;
}
{
int width, height;
get_tty_size (fileno (FRAME_TTY (f)->input), &width, &height);
- adjust_frame_size (f, width, height - FRAME_MENU_BAR_LINES (f), 5, 0, Qnil);
+ adjust_frame_size (f, width, height - FRAME_MENU_BAR_LINES (f),
+ 5, 0, Qterminal_frame);
}
adjust_frame_glyphs (f);
be copied as well. */
for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem))
XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem))));
+
+ f->can_x_set_window_size = true;
+ f->after_make_frame = true;
+
return frame;
}
}
}
- is_tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip")));
+ is_tooltip_frame = !NILP (Fframe_parameter (frame, Qtooltip));
/* Run `delete-frame-functions' unless FORCE is `noelisp' or
frame is a tooltip. FORCE is set to `noelisp' when handling
return Qnil;
}
-DEFUN ("frame-can-run-window-configuration-change-hook",
- Fcan_run_window_configuration_change_hook,
- Scan_run_window_configuration_change_hook, 2, 2, 0,
- doc: /* Whether `window-configuration-change-hook' is run for frame FRAME.
-FRAME nil means use the selected frame. Second argument ALLOW non-nil
+DEFUN ("frame-after-make-frame",
+ Fframe_after_make_frame,
+ Sframe_after_make_frame, 2, 2, 0,
+ doc: /* Mark FRAME as made.
+FRAME nil means use the selected frame. Second argument MADE non-nil
means functions on `window-configuration-change-hook' are called
-whenever the window configuration of FRAME changes. ALLOW nil means
+whenever the window configuration of FRAME changes. MADE nil means
these functions are not called.
-This function is currently called by `face-set-after-frame-default' only
-and should be otherwise used with utter care to avoid that running
-functions on `window-configuration-change-hook' is impeded forever. */)
- (Lisp_Object frame, Lisp_Object allow)
+This function is currently called by `make-frame' only and should be
+otherwise used with utter care to avoid that running functions on
+`window-configuration-change-hook' is impeded forever. */)
+ (Lisp_Object frame, Lisp_Object made)
{
struct frame *f = decode_live_frame (frame);
-
- f->can_run_window_configuration_change_hook = NILP (allow) ? false : true;
- return Qnil;
+ f->after_make_frame = !NILP (made);
+ return made;
}
\f
else
store_in_alist (&alist, Qbackground_color,
tty_color_name (f, FRAME_BACKGROUND_PIXEL (f)));
- store_in_alist (&alist, intern ("font"),
+ store_in_alist (&alist, Qfont,
build_string (FRAME_MSDOS_P (f)
? "ms-dos"
: FRAME_W32_P (f) ? "w32term"
important when param_alist's notion of colors is
"unspecified". We need to do the same here. */
if (STRINGP (value) && !FRAME_WINDOW_P (f))
- value = frame_unspecified_color (f, value);
+ {
+ Lisp_Object tem = frame_unspecified_color (f, value);
+
+ if (!NILP (tem))
+ value = tem;
+ }
}
else
value = Fcdr (Fassq (parameter, Fframe_parameters (frame)));
set them both at once. So we wait until we've looked at the
entire list before we set them. */
int width IF_LINT (= 0), height IF_LINT (= 0);
- bool width_change = 0, height_change = 0;
+ bool width_change = false, height_change = false;
/* Same here. */
Lisp_Object left, top;
/* Same with these. */
Lisp_Object icon_left, icon_top;
+ /* And with this. */
+ Lisp_Object fullscreen;
+ bool fullscreen_change = false;
+
/* Record in these vectors all the parms specified. */
Lisp_Object *parms;
Lisp_Object *values;
icon_top = val;
else if (EQ (prop, Qicon_left))
icon_left = val;
+ else if (EQ (prop, Qfullscreen))
+ {
+ fullscreen = val;
+ fullscreen_change = true;
+ }
else if (EQ (prop, Qforeground_color)
|| EQ (prop, Qbackground_color)
|| EQ (prop, Qfont))
that here since otherwise a size change implied by an
intermittent font change may get lost as in Bug#17142. */
if (!width_change)
- width = (f->new_width
+ width = ((f->can_x_set_window_size && f->new_width)
? (f->new_pixelwise
? f->new_width
: (f->new_width * FRAME_COLUMN_WIDTH (f)))
: FRAME_TEXT_WIDTH (f));
if (!height_change)
- height = (f->new_height
+ height = ((f->can_x_set_window_size && f->new_height)
? (f->new_pixelwise
? f->new_height
: (f->new_height * FRAME_LINE_HEIGHT (f)))
/* Actually set that position, and convert to absolute. */
x_set_offset (f, leftpos, toppos, -1);
}
+
+ if (fullscreen_change)
+ {
+ Lisp_Object old_value = get_frame_param (f, Qfullscreen);
+
+ frame_size_history_add
+ (f, Qx_set_fullscreen, 0, 0, list2 (old_value, fullscreen));
+
+ store_frame_param (f, Qfullscreen, fullscreen);
+ if (!EQ (fullscreen, old_value))
+ x_set_fullscreen (f, fullscreen, old_value);
+ }
+
+
#ifdef HAVE_X_WINDOWS
if ((!NILP (icon_left) || !NILP (icon_top))
&& ! (icon_left_no_change && icon_top_no_change))
#endif
/* Recalculate toolbar height. */
f->n_tool_bar_rows = 0;
+ f->tool_bar_redisplayed_once = false;
/* Ensure we redraw it. */
clear_current_matrices (f);
attribute, class, component, subclass);
}
-#if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT
+#if defined HAVE_X_WINDOWS && !defined USE_X_TOOLKIT && !defined USE_GTK
/* Used when C code wants a resource value. */
/* Called from oldXMenu/Create.c. */
char *
DEFSYM (Qframep, "framep");
DEFSYM (Qframe_live_p, "frame-live-p");
DEFSYM (Qframe_windows_min_size, "frame-windows-min-size");
+ DEFSYM (Qwindow_pixel_to_total, "window--pixel-to-total");
DEFSYM (Qexplicit_name, "explicit-name");
DEFSYM (Qheight, "height");
DEFSYM (Qicon, "icon");
DEFSYM (Qtool_bar_external, "tool-bar-external");
DEFSYM (Qtool_bar_size, "tool-bar-size");
DEFSYM (Qframe_inner_size, "frame-inner-size");
+ /* The following are used for frame_size_history. */
+ DEFSYM (Qadjust_frame_size_1, "adjust-frame-size-1");
+ DEFSYM (Qadjust_frame_size_2, "adjust-frame-size-2");
+ DEFSYM (Qadjust_frame_size_3, "adjust-frame-size-3");
+ DEFSYM (QEmacsFrameResize, "EmacsFrameResize");
+ DEFSYM (Qframe_inhibit_resize, "frame-inhibit-resize");
+ DEFSYM (Qx_set_fullscreen, "x-set-fullscreen");
+ DEFSYM (Qx_check_fullscreen, "x-check-fullscreen");
+ DEFSYM (Qx_set_window_size_1, "x-set-window-size-1");
+ DEFSYM (Qxg_frame_resized, "xg-frame-resized");
+ DEFSYM (Qxg_frame_set_char_size_1, "xg-frame-set-char-size-1");
+ DEFSYM (Qxg_frame_set_char_size_2, "xg-frame-set-char-size-2");
+ DEFSYM (Qxg_frame_set_char_size_3, "xg-frame-set-char-size-3");
+ DEFSYM (Qxg_change_toolbar_position, "xg-change-toolbar-position");
+ DEFSYM (Qx_net_wm_state, "x-net-wm-state");
+ DEFSYM (Qx_handle_net_wm_state, "x-handle-net-wm-state");
+ DEFSYM (Qtb_size_cb, "tb-size-cb");
+ DEFSYM (Qupdate_frame_tool_bar, "update-frame-tool-bar");
+ DEFSYM (Qfree_frame_tool_bar, "free-frame-tool-bar");
+
DEFSYM (Qchange_frame_size, "change-frame-size");
DEFSYM (Qxg_frame_set_char_size, "xg-frame-set-char-size");
DEFSYM (Qset_window_configuration, "set-window-configuration");
DEFSYM (Qx_create_frame_1, "x-create-frame-1");
DEFSYM (Qx_create_frame_2, "x-create-frame-2");
+ DEFSYM (Qtip_frame, "tip-frame");
+ DEFSYM (Qterminal_frame, "terminal-frame");
#ifdef HAVE_NS
DEFSYM (Qns_parse_geometry, "ns-parse-geometry");
frame_inhibit_implied_resize = Qt;
#endif
- DEFVAR_LISP ("frame-adjust-size-history", Vframe_adjust_size_history,
- doc: /* History of frame size adjustments. */);
- Vframe_adjust_size_history = Qnil;
+ DEFVAR_LISP ("frame-size-history", frame_size_history,
+ doc: /* History of frame size adjustments.
+If non-nil, list recording frame size adjustment. Adjustments are
+recorded only if the first element of this list is a positive number.
+Adding an adjustment decrements that number by one.
+
+The remaining elements are the adjustments. Each adjustment is a list
+of four elements `frame', `function', `sizes' and `more'. `frame' is
+the affected frame and `function' the invoking function. `sizes' is
+usually a list of four elements `old-width', `old-height', `new-width'
+and `new-height' representing the old and new sizes recorded/requested
+by `function'. `more' is a list with additional information.
+
+The function `frame--size-history' displays the value of this variable
+in a more readable form. */);
+ frame_size_history = Qnil;
staticpro (&Vframe_list);
defsubr (&Sraise_frame);
defsubr (&Slower_frame);
defsubr (&Sx_focus_frame);
- defsubr (&Scan_run_window_configuration_change_hook);
+ defsubr (&Sframe_after_make_frame);
defsubr (&Sredirect_frame_focus);
defsubr (&Sframe_focus);
defsubr (&Sframe_parameters);
frame. */
bool_bf can_x_set_window_size : 1;
- /* True means run_window_configuration_change_hook can be processed
- for this frame. */
- bool_bf can_run_window_configuration_change_hook : 1;
+ /* Set to true after this frame was made by `make-frame'. */
+ bool_bf after_make_frame : 1;
/* True means tool bar has been redisplayed at least once in current
session. */
int left_pos, top_pos;
/* Total width of this frame (including fringes, vertical scroll bar
- and internal border widths) and total height (including menu bar,
- tool bar, horizontal scroll bar and internal border widths) in
- pixels. */
+ and internal border widths) and total height (including internal
+ menu and tool bars, horizontal scroll bar and internal border
+ widths) in pixels. */
int pixel_width, pixel_height;
- /* These many pixels are the difference between the outer window (i.e. the
- left and top of the window manager decoration) and FRAME_X_WINDOW. */
- int x_pixels_diff, y_pixels_diff;
-
/* This is the gravity value for the specified window position. */
int win_gravity;
extern Lisp_Object selected_frame;
+#if ! (defined USE_GTK || defined HAVE_NS)
extern int frame_default_tool_bar_height;
+#endif
extern struct frame *decode_window_system_frame (Lisp_Object);
extern struct frame *decode_live_frame (Lisp_Object);
extern Lisp_Object delete_frame (Lisp_Object, Lisp_Object);
extern bool frame_inhibit_resize (struct frame *, bool, Lisp_Object);
extern void adjust_frame_size (struct frame *, int, int, int, bool, Lisp_Object);
+extern void frame_size_history_add (struct frame *f, Lisp_Object fun_symbol,
+ int width, int height, Lisp_Object rest);
extern Lisp_Object Vframe_list;
{
Lisp_Object obj = assq_no_quit (Qicon_type, f->param_alist);
- if (CONSP (obj))
+ if (CONSP (obj) && !NILP (XCDR (obj)))
x_bitmap_icon (f, XCDR (obj));
}
DEFSYM (Qmonospace, "monospace");
DEFSYM (Qsans_serif, "sans-serif");
DEFSYM (Qserif, "serif");
- DEFSYM (Qmono, "mono");
DEFSYM (Qsans, "sans");
DEFSYM (Qsans__serif, "sans serif");
#include "emacsgtkfixed.h"
#endif
-/** #define FRAME_TOTAL_PIXEL_HEIGHT(f) \ **/
-/** (FRAME_PIXEL_HEIGHT (f) + FRAME_MENUBAR_HEIGHT (f) + FRAME_TOOLBAR_HEIGHT (f)) **/
-
-/** #define FRAME_TOTAL_PIXEL_WIDTH(f) \ **/
-/** (FRAME_PIXEL_WIDTH (f) + FRAME_TOOLBAR_WIDTH (f)) **/
-
#ifndef HAVE_GTK_WIDGET_SET_HAS_WINDOW
#define gtk_widget_set_has_window(w, b) \
(gtk_fixed_set_has_window (GTK_FIXED (w), b))
{
GdkDisplay *gdpy;
+ unrequest_sigio (); // See comment in x_display_ok, xterm.c.
gdpy = gdk_display_open (display_name);
+ request_sigio ();
if (!gdpy_def && gdpy)
{
gdpy_def = gdpy;
if (pixelwidth == -1 && pixelheight == -1)
{
if (FRAME_GTK_WIDGET (f) && gtk_widget_get_mapped (FRAME_GTK_WIDGET (f)))
- gdk_window_get_geometry (gtk_widget_get_window (FRAME_GTK_WIDGET (f)),
- 0, 0,
- &pixelwidth, &pixelheight);
- else return;
+ gdk_window_get_geometry (gtk_widget_get_window (FRAME_GTK_WIDGET (f)),
+ 0, 0, &pixelwidth, &pixelheight);
+ else
+ return;
}
-
width = FRAME_PIXEL_TO_TEXT_WIDTH (f, pixelwidth);
height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, pixelheight);
+ frame_size_history_add
+ (f, Qxg_frame_resized, width, height, Qnil);
+
if (width != FRAME_TEXT_WIDTH (f)
|| height != FRAME_TEXT_HEIGHT (f)
|| pixelwidth != FRAME_PIXEL_WIDTH (f)
|| pixelheight != FRAME_PIXEL_HEIGHT (f))
{
- FRAME_PIXEL_WIDTH (f) = pixelwidth;
- FRAME_PIXEL_HEIGHT (f) = pixelheight;
-
xg_clear_under_internal_border (f);
change_frame_size (f, width, height, 0, 1, 0, 1);
SET_FRAME_GARBAGED (f);
{
int pixelwidth = FRAME_TEXT_TO_PIXEL_WIDTH (f, width);
int pixelheight = FRAME_TEXT_TO_PIXEL_HEIGHT (f, height);
+ Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ gint gwidth, gheight;
if (FRAME_PIXEL_HEIGHT (f) == 0)
return;
+ gtk_window_get_size (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
+ &gwidth, &gheight);
+
/* Do this before resize, as we don't know yet if we will be resized. */
xg_clear_under_internal_border (f);
- /* Must resize our top level widget. Font size may have changed,
- but not rows/cols. */
- gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
- pixelwidth + FRAME_TOOLBAR_WIDTH (f),
- pixelheight + FRAME_TOOLBAR_HEIGHT (f)
- + FRAME_MENUBAR_HEIGHT (f));
- x_wm_set_size_hint (f, 0, 0);
+ /* Resize the top level widget so rows and columns remain constant.
+
+ When the frame is fullheight and we only want to change the width
+ or it is fullwidth and we only want to change the height we should
+ be able to preserve the fullscreen property. However, due to the
+ fact that we have to send a resize request anyway, the window
+ manager will abolish it. At least the respective size should
+ remain unchanged but giving the frame back its normal size will
+ be broken ... */
+ if (EQ (fullscreen, Qfullwidth) && width == FRAME_TEXT_WIDTH (f))
+ {
+ frame_size_history_add
+ (f, Qxg_frame_set_char_size_1, width, height,
+ list2 (make_number (gheight),
+ make_number (pixelheight + FRAME_TOOLBAR_HEIGHT (f)
+ + FRAME_MENUBAR_HEIGHT (f))));
+
+ gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
+ gwidth,
+ pixelheight + FRAME_TOOLBAR_HEIGHT (f)
+ + FRAME_MENUBAR_HEIGHT (f));
+ }
+ else if (EQ (fullscreen, Qfullheight) && height == FRAME_TEXT_HEIGHT (f))
+ {
+ frame_size_history_add
+ (f, Qxg_frame_set_char_size_2, width, height,
+ list2 (make_number (gwidth),
+ make_number (pixelwidth + FRAME_TOOLBAR_WIDTH (f))));
+
+ gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
+ pixelwidth + FRAME_TOOLBAR_WIDTH (f),
+ gheight);
+ }
+
+ else
+ {
+ frame_size_history_add
+ (f, Qxg_frame_set_char_size_3, width, height,
+ list2 (make_number (pixelwidth + FRAME_TOOLBAR_WIDTH (f)),
+ make_number (pixelheight + FRAME_TOOLBAR_HEIGHT (f)
+ + FRAME_MENUBAR_HEIGHT (f))));
+
+ gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
+ pixelwidth + FRAME_TOOLBAR_WIDTH (f),
+ pixelheight + FRAME_TOOLBAR_HEIGHT (f)
+ + FRAME_MENUBAR_HEIGHT (f));
+ fullscreen = Qnil;
+ }
SET_FRAME_GARBAGED (f);
cancel_mouse_face (f);
+ x_wm_set_size_hint (f, 0, 0);
/* We can not call change_frame_size for a mapped frame,
we can not set pixel width/height either. The window manager may
override our resize request, XMonad does this all the time.
(void)gtk_events_pending ();
gdk_flush ();
x_wait_for_event (f, ConfigureNotify);
+
+ if (!NILP (fullscreen))
+ /* Try to restore fullscreen state. */
+ {
+ store_frame_param (f, Qfullscreen, fullscreen);
+ x_set_fullscreen (f, fullscreen, fullscreen);
+ }
}
else
- adjust_frame_size (f, -1, -1, 5, 0, Qxg_frame_set_char_size);
+ adjust_frame_size (f, width, height, 5, 0, Qxg_frame_set_char_size);
+
}
/* Handle height/width changes (i.e. add/remove/move menu/toolbar).
gtk_widget_destroy (wscroll);
g_object_unref (G_OBJECT (wscroll));
w += 2*b;
+#ifndef HAVE_GTK3
if (w < 16) w = 16;
+#endif
scroll_bar_width_for_theme = w;
}
allocated between widgets, it may get another. So we must update
size hints if tool bar size changes. Seen on Fedora 18 at least. */
struct frame *f = user_data;
+
if (xg_update_tool_bar_sizes (f))
- adjust_frame_size (f, -1, -1, 2, 0, Qtool_bar_lines);
+ {
+ frame_size_history_add (f, Qtb_size_cb, 0, 0, Qnil);
+ adjust_frame_size (f, -1, -1, 5, 0, Qtool_bar_lines);
+ }
}
/* Create a tool bar for frame F. */
FRAME_TOOLBAR_RIGHT_WIDTH (f) = nr;
FRAME_TOOLBAR_TOP_HEIGHT (f) = nt;
FRAME_TOOLBAR_BOTTOM_HEIGHT (f) = nb;
- return 1;
- }
- return 0;
+ return true;
+ }
+ else
+ return false;
}
static char *
xg_pack_tool_bar (f, FRAME_TOOL_BAR_POSITION (f));
gtk_widget_show_all (x->toolbar_widget);
if (xg_update_tool_bar_sizes (f))
- adjust_frame_size (f, -1, -1, 2, 0, Qtool_bar_lines);
+ {
+ frame_size_history_add (f, Qupdate_frame_tool_bar, 0, 0, Qnil);
+ adjust_frame_size (f, -1, -1, 2, 0, Qtool_bar_lines);
+ }
}
unblock_input ();
NULL);
}
+ frame_size_history_add (f, Qfree_frame_tool_bar, 0, 0, Qnil);
adjust_frame_size (f, -1, -1, 2, 0, Qtool_bar_lines);
unblock_input ();
xg_pack_tool_bar (f, pos);
g_object_unref (top_widget);
+
if (xg_update_tool_bar_sizes (f))
- adjust_frame_size (f, -1, -1, 2, 0, Qtool_bar_lines);
+ {
+ frame_size_history_add (f, Qxg_change_toolbar_position, 0, 0, Qnil);
+ adjust_frame_size (f, -1, -1, 2, 0, Qtool_bar_lines);
+ }
+
unblock_input ();
}
-1, hscroll, 0, w);
}
-DEFUN ("vertical-motion", Fvertical_motion, Svertical_motion, 1, 2, 0,
+/* In window W (derived from WINDOW), return x coordinate for column
+ COL (derived from COLUMN). */
+static int
+window_column_x (struct window *w, Lisp_Object window,
+ double col, Lisp_Object column)
+{
+ double x = col * FRAME_COLUMN_WIDTH (XFRAME (w->frame)) + 0.5;
+
+ /* FIXME: Should this be limited to W's dimensions? */
+ if (! (INT_MIN <= x && x <= INT_MAX))
+ args_out_of_range (window, column);
+
+ return x;
+}
+
+DEFUN ("vertical-motion", Fvertical_motion, Svertical_motion, 1, 3, 0,
doc: /* Move point to start of the screen line LINES lines down.
If LINES is negative, this means moving up.
visually, i.e., as addition to the columns of text beyond the left
edge of the window.
+The optional third argument CUR-COL specifies the horizontal
+window-relative coordinate of point, in units of frame's canonical
+character width, where the function is invoked. If this argument is
+omitted or nil, the function will determine the point coordinate by
+going back to the beginning of the line.
+
`vertical-motion' always uses the current buffer,
regardless of which buffer is displayed in WINDOW.
This is consistent with other cursor motion functions
and makes it possible to use `vertical-motion' in any buffer,
whether or not it is currently displayed in some window. */)
- (Lisp_Object lines, Lisp_Object window)
+ (Lisp_Object lines, Lisp_Object window, Lisp_Object cur_col)
{
struct it it;
struct text_pos pt;
Lisp_Object old_buffer;
EMACS_INT old_charpos IF_LINT (= 0), old_bytepos IF_LINT (= 0);
struct gcpro gcpro1;
- Lisp_Object lcols = Qnil;
- double cols IF_LINT (= 0);
+ Lisp_Object lcols;
void *itdata = NULL;
/* Allow LINES to be of the form (HPOS . VPOS) aka (COLUMNS . LINES). */
- if (CONSP (lines) && (NUMBERP (XCAR (lines))))
+ bool lcols_given = CONSP (lines);
+ if (lcols_given)
{
lcols = XCAR (lines);
- cols = INTEGERP (lcols) ? (double) XINT (lcols) : XFLOAT_DATA (lcols);
lines = XCDR (lines);
}
bool disp_string_at_start_p = 0;
ptrdiff_t nlines = XINT (lines);
int vpos_init = 0;
+ double start_col;
+ int start_x IF_LINT (= 0);
+ int to_x = -1;
+
+ bool start_x_given = !NILP (cur_col);
+ if (start_x_given)
+ {
+ start_col = extract_float (cur_col);
+ start_x = window_column_x (w, window, start_col, cur_col);
+ }
itdata = bidi_shelve_cache ();
SET_TEXT_POS (pt, PT, PT_BYTE);
it_overshoot_count =
!(it.method == GET_FROM_IMAGE || it.method == GET_FROM_STRETCH);
- /* Scan from the start of the line containing PT. If we don't
- do this, we start moving with IT->current_x == 0, while PT is
- really at some x > 0. */
- reseat_at_previous_visible_line_start (&it);
- it.current_x = it.hpos = 0;
+ if (start_x_given)
+ {
+ it.hpos = start_col;
+ it.current_x = start_x;
+ }
+ else
+ {
+ /* Scan from the start of the line containing PT. If we don't
+ do this, we start moving with IT->current_x == 0, while PT is
+ really at some x > 0. */
+ reseat_at_previous_visible_line_start (&it);
+ it.current_x = it.hpos = 0;
+ }
if (IT_CHARPOS (it) != PT)
/* We used to temporarily disable selective display here; the
comment said this is "so we don't move too far" (2005-01-19
return the correct value to the caller. */
vpos_init = -1;
}
+ if (lcols_given)
+ to_x = window_column_x (w, window, extract_float (lcols), lcols);
if (nlines <= 0)
{
it.vpos = vpos_init;
/* Do this even if LINES is 0, so that we move back to the
beginning of the current line as we ought. */
- if (nlines == 0 || IT_CHARPOS (it) > 0)
+ if ((nlines < 0 && IT_CHARPOS (it) > 0)
+ || (nlines == 0 && !(start_x_given && start_x <= to_x)))
move_it_by_lines (&it, max (PTRDIFF_MIN, nlines));
}
else if (overshoot_handled)
/* Move to the goal column, if one was specified. If the window
was originally hscrolled, the goal column is interpreted as
an addition to the hscroll amount. */
- if (!NILP (lcols))
- {
- int to_x = (int)(cols * FRAME_COLUMN_WIDTH (XFRAME (w->frame)) + 0.5);
-
- move_it_in_display_line (&it, ZV, first_x + to_x, MOVE_TO_X);
- }
+ if (lcols_given)
+ move_it_in_display_line (&it, ZV, first_x + to_x, MOVE_TO_X);
SET_PT_BOTH (IT_CHARPOS (it), IT_BYTEPOS (it));
bidi_unshelve_cache (itdata, 0);
#define TEXT_PROP_MEANS_INVISIBLE(prop) \
(EQ (BVAR (current_buffer, invisibility_spec), Qt) \
? !NILP (prop) \
- : invisible_p (prop, BVAR (current_buffer, invisibility_spec)))
+ : invisible_prop (prop, BVAR (current_buffer, invisibility_spec)))
/* Declared in alloc.c. */
extern INTERVAL interval_of (ptrdiff_t, Lisp_Object);
/* Defined in xdisp.c. */
-extern int invisible_p (Lisp_Object, Lisp_Object);
+extern int invisible_prop (Lisp_Object, Lisp_Object);
/* Defined in textprop.c. */
extern Lisp_Object copy_text_properties (Lisp_Object, Lisp_Object,
Lisp_Object keys;
ptrdiff_t key_count;
bool key_count_reset;
+ ptrdiff_t command_key_start;
struct gcpro gcpro1;
ptrdiff_t count = SPECPDL_INDEX ();
/* Save the this_command_keys status. */
key_count = this_command_key_count;
key_count_reset = this_command_key_count_reset;
+ command_key_start = this_single_command_key_start;
if (key_count > 0)
keys = Fcopy_sequence (this_command_keys);
/* Clear out this_command_keys. */
this_command_key_count = 0;
this_command_key_count_reset = 0;
+ this_single_command_key_start = 0;
/* Now wipe the echo area. */
if (!NILP (echo_area_buffer[0]))
and this_command_keys state. */
this_command_key_count = key_count;
this_command_key_count_reset = key_count_reset;
+ this_single_command_key_start = command_key_start;
if (key_count > 0)
this_command_keys = keys;
cancel_echoing ();
ok_to_echo_at_next_pause = saved_ok_to_echo;
- kset_echo_string (current_kboard, saved_echo_string);
+ /* Do not restore the echo area string when the user is
+ introducing a prefix argument. Otherwise we end with
+ repetitions of the partially introduced prefix
+ argument. (bug#19875) */
+ if (NILP (intern ("prefix-arg")))
+ {
+ kset_echo_string (current_kboard, saved_echo_string);
+ }
current_kboard->echo_after_prompt = saved_echo_after_prompt;
if (saved_immediate_echo)
echo_now ();
if (noninteractive
/* In case we are running as a daemon, only do this before
detaching from the terminal. */
- || (IS_DAEMON && daemon_pipe[1] >= 0))
+ || (IS_DAEMON && DAEMON_RUNNING))
{
int c = getchar ();
XSETINT (obj, c);
obj = make_lispy_event (event);
kbd_fetch_ptr = event + 1;
}
-#endif
-#ifdef HAVE_XWIDGETS
- else if (event->kind == XWIDGET_EVENT)
- {
- obj = make_lispy_event (event);
- kbd_fetch_ptr = event + 1;
- }
-#endif
-#ifdef HAVE_INOTIFY
- else if (event->kind == FILE_NOTIFY_EVENT)
- {
- obj = make_lispy_event (event);
- kbd_fetch_ptr = event + 1;
- }
#endif
else if (event->kind == CONFIG_CHANGED_EVENT)
{
static bool
decode_timer (Lisp_Object timer, struct timespec *result)
{
- Lisp_Object *vector;
+ Lisp_Object *vec;
if (! (VECTORP (timer) && ASIZE (timer) == 9))
return 0;
- vector = XVECTOR (timer)->contents;
- if (! NILP (vector[0]))
+ vec = XVECTOR (timer)->contents;
+ if (! NILP (vec[0]))
return 0;
- if (! INTEGERP (vector[2]))
+ if (! INTEGERP (vec[2]))
return false;
struct lisp_time t;
- if (! decode_time_components (vector[1], vector[2], vector[3], vector[8],
- &t, 0))
+ if (decode_time_components (vec[1], vec[2], vec[3], vec[8], &t, 0) <= 0)
return false;
*result = lisp_to_timespec (t);
return timespec_valid_p (*result);
/* 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).
+ this timer becomes ripe.
Skip past invalid timers and timers already handled. */
if (CONSP (timers))
{
dy = yret = wy;
}
- /* For clicks in the text area, fringes, or margins, call
- buffer_posn_from_coords to extract TEXTPOS, the buffer
- position nearest to the click. */
+ /* For clicks in the text area, fringes, margins, or vertical
+ scroll bar, call buffer_posn_from_coords to extract TEXTPOS,
+ the buffer position nearest to the click. */
if (!textpos)
{
Lisp_Object string2, object2 = Qnil;
int dx2, dy2;
int width2, height2;
/* The pixel X coordinate passed to buffer_posn_from_coords
- is the X coordinate relative to the text area for
- text-area and right-margin clicks, zero otherwise. */
+ is the X coordinate relative to the text area for clicks
+ in text-area, right-margin/fringe and right-side vertical
+ scroll bar, zero otherwise. */
int x2
= (part == ON_TEXT) ? xret
- : (part == ON_RIGHT_FRINGE || part == ON_RIGHT_MARGIN)
+ : (part == ON_RIGHT_FRINGE || part == ON_RIGHT_MARGIN
+ || (part == ON_VERTICAL_SCROLL_BAR
+ && WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w)))
? (XINT (x) - window_box_left (w, TEXT_AREA))
: 0;
int y2 = wy;
}
#endif /* HAVE_DBUS */
-#ifdef HAVE_XWIDGETS
- case XWIDGET_EVENT:
- {
- return Fcons (Qxwidget_event,event->arg);
- }
-#endif /* HAVE_XWIDGETS */
-
-
#if defined HAVE_GFILENOTIFY || defined HAVE_INOTIFY
case FILE_NOTIFY_EVENT:
{
/* Record what part of this_command_keys is the current key sequence. */
this_single_command_key_start = this_command_key_count - t;
+ /* When 'input-method-function' called above causes events to be
+ put on 'unread-post-input-method-events', and as result
+ 'reread' is set to 'true', the value of 't' can become larger
+ than 'this_command_key_count', because 'add_command_key' is
+ not called to update 'this_command_key_count'. If this
+ happens, 'this_single_command_key_start' will become negative
+ above, and any call to 'this-single-command-keys' will return
+ a garbled vector. See bug #20223 for one such situation.
+ Here we force 'this_single_command_key_start' to never become
+ negative, to avoid that. */
+ if (this_single_command_key_start < 0)
+ this_single_command_key_start = 0;
/* Look for this sequence in input-decode-map.
Scan from indec.end until we find a bound suffix. */
DEFSYM (Qdbus_event, "dbus-event");
#endif
-#ifdef HAVE_XWIDGETS
- DEFSYM (Qxwidget_event,"xwidget-event");
-#endif /* HAVE_XWIDGETS */
#ifdef USE_FILE_NOTIFY
DEFSYM (Qfile_notify, "file-notify");
#endif /* USE_FILE_NOTIFY */
DEFVAR_LISP ("special-event-map", Vspecial_event_map,
doc: /* Keymap defining bindings for special events to execute at low level. */);
- Vspecial_event_map = list1 (intern_c_string ("keymap"));
+ Vspecial_event_map = list1 (Qkeymap);
DEFVAR_LISP ("track-mouse", do_mouse_tracking,
doc: /* Non-nil means generate motion events for mouse motion. */);
The input method function should refer to the variables
`input-method-use-echo-area' and `input-method-exit-on-first-char'
for guidance on what to do. */);
- Vinput_method_function = Qnil;
+ Vinput_method_function = Qlist;
DEFVAR_LISP ("input-method-previous-message",
Vinput_method_previous_message,
staticpro (&Vmouse_events);
Vmouse_events = listn (CONSTYPE_PURE, 9,
Qmenu_bar,
- intern_c_string ("tool-bar"),
- intern_c_string ("header-line"),
+ Qtool_bar,
+ Qheader_line,
Qmode_line,
intern_c_string ("mouse-1"),
intern_c_string ("mouse-2"),
Lisp_Misc_Marker,
Lisp_Misc_Overlay,
Lisp_Misc_Save_Value,
+ Lisp_Misc_Finalizer,
/* Currently floats are not a misc type,
but let's define this in case we want to change that. */
Lisp_Misc_Float,
INLINE bool PROCESSP (Lisp_Object);
INLINE bool PSEUDOVECTORP (Lisp_Object, int);
INLINE bool SAVE_VALUEP (Lisp_Object);
+INLINE bool FINALIZERP (Lisp_Object);
INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
Lisp_Object);
INLINE bool STRINGP (Lisp_Object);
INLINE bool WINDOWP (Lisp_Object);
INLINE bool TERMINALP (Lisp_Object);
INLINE struct Lisp_Save_Value *XSAVE_VALUE (Lisp_Object);
+INLINE struct Lisp_Finalizer *XFINALIZER (Lisp_Object);
INLINE struct Lisp_Symbol *(XSYMBOL) (Lisp_Object);
INLINE void *(XUNTAG) (Lisp_Object, int);
/* Declare extern constants for Lisp symbols. These can be helpful
when using a debugger like GDB, on older platforms where the debug
format does not represent C macros. */
-#define DEFINE_LISP_SYMBOL_BEGIN(name) \
- DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name)
-#define DEFINE_LISP_SYMBOL_END(name) \
+#define DEFINE_LISP_SYMBOL(name) \
+ DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) \
DEFINE_GDB_SYMBOL_END (LISP_INITIALLY (XLI_BUILTIN_LISPSYM (i##name)))
+/* By default, define macros for Qt, etc., as this leads to a bit
+ better performance in the core Emacs interpreter. A plugin can
+ define DEFINE_NON_NIL_Q_SYMBOL_MACROS to be false, to be portable to
+ other Emacs instances that assign different values to Qt, etc. */
+#ifndef DEFINE_NON_NIL_Q_SYMBOL_MACROS
+# define DEFINE_NON_NIL_Q_SYMBOL_MACROS true
+#endif
+
#include "globals.h"
/* Convert a Lisp_Object to the corresponding EMACS_INT and vice versa.
PVEC_WINDOW_CONFIGURATION,
PVEC_SUBR,
PVEC_OTHER,
-#ifdef HAVE_XWIDGETS
- PVEC_XWIDGET,
- PVEC_XWIDGET_VIEW,
-#endif
-
/* These should be last, check internal_equal to see why. */
PVEC_COMPILED,
PVEC_CHAR_TABLE,
return XSAVE_VALUE (obj)->data[n].object;
}
+/* A finalizer sentinel. */
+struct Lisp_Finalizer
+ {
+ struct Lisp_Misc_Any base;
+
+ /* Circular list of all active weak references. */
+ struct Lisp_Finalizer *prev;
+ struct Lisp_Finalizer *next;
+
+ /* Call FUNCTION when the finalizer becomes unreachable, even if
+ FUNCTION contains a reference to the finalizer; i.e., call
+ FUNCTION when it is reachable _only_ through finalizers. */
+ Lisp_Object function;
+ };
+
/* A miscellaneous object, when it's on the free list. */
struct Lisp_Free
{
struct Lisp_Marker u_marker;
struct Lisp_Overlay u_overlay;
struct Lisp_Save_Value u_save_value;
+ struct Lisp_Finalizer u_finalizer;
};
INLINE union Lisp_Misc *
eassert (SAVE_VALUEP (a));
return & XMISC (a)->u_save_value;
}
+
+INLINE struct Lisp_Finalizer *
+XFINALIZER (Lisp_Object a)
+{
+ eassert (FINALIZERP (a));
+ return & XMISC (a)->u_finalizer;
+}
+
\f
/* Forwarding pointer to an int variable.
This is allowed only in the value cell of a symbol,
return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value;
}
+INLINE bool
+FINALIZERP (Lisp_Object x)
+{
+ return MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Finalizer;
+}
+
INLINE bool
AUTOLOADP (Lisp_Object x)
{
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 void setup_echo_area_for_printing (bool);
extern bool push_message (void);
extern void pop_message_unwind (void);
extern Lisp_Object restore_message_unwind (Lisp_Object);
extern void message3 (Lisp_Object);
extern void message3_nolog (Lisp_Object);
extern void message_dolog (const char *, ptrdiff_t, bool, bool);
-extern void message_with_string (const char *, Lisp_Object, int);
+extern void message_with_string (const char *, Lisp_Object, bool);
extern void message_log_maybe_newline (void);
extern void update_echo_area (void);
extern void truncate_echo_area (ptrdiff_t);
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 *, ptrdiff_t, int *,
- int *, int *, int *, int *, int *);
+extern bool pos_visible_p (struct window *, ptrdiff_t, int *,
+ int *, int *, int *, int *, int *);
/* Defined in xsettings.c. */
extern void syms_of_xsettings (void);
extern bool no_site_lisp;
/* Pipe used to send exit notification to the daemon parent at
- startup. */
+ startup. On Windows, we use a kernel event instead. */
+#ifndef WINDOWSNT
extern int daemon_pipe[2];
#define IS_DAEMON (daemon_pipe[1] != 0)
+#define DAEMON_RUNNING (daemon_pipe[1] >= 0)
+#else /* WINDOWSNT */
+extern void *w32_daemon_event;
+#define IS_DAEMON (w32_daemon_event != NULL)
+#define DAEMON_RUNNING (w32_daemon_event != INVALID_HANDLE_VALUE)
+#endif
/* True if handling a fatal error already. */
extern bool fatal_error_in_progress;
#include <sys/file.h>
#include <errno.h>
#include <limits.h> /* For CHAR_BIT. */
+#include <math.h>
#include <stat-time.h>
#include "lisp.h"
#include "intervals.h"
bool compiled = 0;
Lisp_Object handler;
bool safe_p = 1;
- const char *fmode = "r";
+ const char *fmode = "r" FOPEN_TEXT;
int version;
-#ifdef DOS_NT
- fmode = "rt";
-#endif /* DOS_NT */
-
CHECK_STRING (file);
/* If file name is magic, call the handler. */
compiled = 1;
efound = ENCODE_FILE (found);
-
-#ifdef DOS_NT
- fmode = "rb";
-#endif /* DOS_NT */
+ fmode = "r" FOPEN_BINARY;
/* openp already checked for newness, no point doing it again.
FIXME would be nice to get a message when openp
{
case Lisp_Vectorlike:
{
- ptrdiff_t i, length = 0;
+ ptrdiff_t i = 0, length = 0;
if (BOOL_VECTOR_P (subtree))
return subtree; /* No sub-objects anyway. */
else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
behavior. */
wrong_type_argument (Qsequencep, subtree);
- for (i = 0; i < length; i++)
+ if (SUB_CHAR_TABLE_P (subtree))
+ i = 2;
+ for ( ; i < length; i++)
SUBSTITUTE (AREF (subtree, i),
ASET (subtree, i, true_value));
return subtree;
bool float_syntax = 0;
double value = 0;
- /* Compute NaN and infinities using a variable, to cope with compilers that
- think they are smarter than we are. */
- double zero = 0;
-
/* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
IEEE floating point hosts, and works around a formerly-common bug where
atof ("-0.0") drops the sign. */
{
state |= E_EXP;
cp += 3;
- value = 1.0 / zero;
+ value = INFINITY;
}
else if (cp[-1] == '+'
&& cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
{
state |= E_EXP;
cp += 3;
- value = zero / zero;
-
- /* If that made a "negative" NaN, negate it. */
- {
- int i;
- union { double d; char c[sizeof (double)]; }
- u_data, u_minus_zero;
- u_data.d = value;
- u_minus_zero.d = -0.0;
- for (i = 0; i < sizeof (double); i++)
- if (u_data.c[i] & u_minus_zero.c[i])
- {
- value = -value;
- break;
- }
- }
- /* Now VALUE is a positive NaN. */
+ /* NAN is a "positive" NaN on all known Emacs hosts. */
+ value = NAN;
}
else
cp = ecp;
/* Use the mouse's current position. */
struct frame *new_f = SELECTED_FRAME ();
#ifdef HAVE_X_WINDOWS
- /* Can't use mouse_position_hook for X since it returns
- coordinates relative to the window the mouse is in,
- we need coordinates relative to the edit widget always. */
- if (new_f != 0)
+ if (FRAME_X_P (new_f))
{
- int cur_x, cur_y;
-
- x_relative_mouse_position (new_f, &cur_x, &cur_y);
- /* cur_x/y may be negative, so use make_number. */
- x = make_number (cur_x);
- y = make_number (cur_y);
+ /* Can't use mouse_position_hook for X since it returns
+ coordinates relative to the window the mouse is in,
+ we need coordinates relative to the edit widget always. */
+ if (new_f != 0)
+ {
+ int cur_x, cur_y;
+
+ x_relative_mouse_position (new_f, &cur_x, &cur_y);
+ /* cur_x/y may be negative, so use make_number. */
+ x = make_number (cur_x);
+ y = make_number (cur_y);
+ }
+ }
+ else
+#endif /* HAVE_X_WINDOWS */
+ {
+ Lisp_Object bar_window;
+ enum scroll_bar_part part;
+ Time time;
+ void (*mouse_position_hook) (struct frame **, int,
+ Lisp_Object *,
+ enum scroll_bar_part *,
+ Lisp_Object *,
+ Lisp_Object *,
+ Time *) =
+ FRAME_TERMINAL (new_f)->mouse_position_hook;
+
+ if (mouse_position_hook)
+ (*mouse_position_hook) (&new_f, 1, &bar_window,
+ &part, &x, &y, &time);
}
-
-#else /* not HAVE_X_WINDOWS */
- Lisp_Object bar_window;
- enum scroll_bar_part part;
- Time time;
- void (*mouse_position_hook) (struct frame **, int,
- Lisp_Object *,
- enum scroll_bar_part *,
- Lisp_Object *,
- Lisp_Object *,
- Time *) =
- FRAME_TERMINAL (new_f)->mouse_position_hook;
-
- if (mouse_position_hook)
- (*mouse_position_hook) (&new_f, 1, &bar_window,
- &part, &x, &y, &time);
-#endif /* not HAVE_X_WINDOWS */
if (new_f != 0)
XSETFRAME (window, new_f);
Lisp_Object dummy, frame;
specbind (Qminibuffer_default, defalt);
- specbind (intern ("inhibit-read-only"), Qnil);
+ specbind (Qinhibit_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 ((noninteractive
/* In case we are running as a daemon, only do this before
detaching from the terminal. */
- || (IS_DAEMON && (daemon_pipe[1] >= 0)))
+ || (IS_DAEMON && DAEMON_RUNNING))
&& NILP (Vexecuting_kbd_macro))
{
val = read_minibuf_noninteractive (map, initial, prompt,
return Fintern (name, Qnil);
}
-DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 3, 0,
+DEFUN ("read-buffer", Fread_buffer, Sread_buffer, 1, 4, 0,
doc: /* Read the name of a buffer and return as a string.
Prompt with PROMPT.
Optional second arg DEF is value to return if user enters an empty line.
If `read-buffer-completion-ignore-case' is non-nil, completion ignores
case while reading the buffer name.
If `read-buffer-function' is non-nil, this works by calling it as a
-function, instead of the usual behavior. */)
- (Lisp_Object prompt, Lisp_Object def, Lisp_Object require_match)
+function, instead of the usual behavior.
+Optional arg PREDICATE if non-nil is a function limiting the buffers that can
+be considered. */)
+ (Lisp_Object prompt, Lisp_Object def, Lisp_Object require_match,
+ Lisp_Object predicate)
{
Lisp_Object result;
char *s;
}
result = Fcompleting_read (prompt, intern ("internal-complete-buffer"),
- Qnil, require_match, Qnil,
+ predicate, require_match, Qnil,
Qbuffer_name_history, def, Qnil);
}
else
- result = call3 (Vread_buffer_function, prompt, def, require_match);
+ result = (NILP (predicate)
+ /* Partial backward compatibility for older read_buffer_functions
+ which don't expect a `predicate' argument. */
+ ? call3 (Vread_buffer_function, prompt, def, require_match)
+ : call4 (Vread_buffer_function, prompt, def, require_match,
+ predicate));
return unbind_to (count, result);
}
\f
doc: /* Text properties that are added to minibuffer prompts.
These are in addition to the basic `field' property, and stickiness
properties. */);
- /* We use `intern' here instead of Qread_only to avoid
- initialization-order problems. */
- Vminibuffer_prompt_properties = list2 (intern_c_string ("read-only"), Qt);
+ Vminibuffer_prompt_properties = list2 (Qread_only, Qt);
DEFVAR_LISP ("read-hide-char", Vread_hide_char,
doc: /* Whether to hide input characters in noninteractive mode.
switch (arg)
{
case FILLED_BOX_CURSOR: return Qbox;
- case HOLLOW_BOX_CURSOR: return intern ("hollow");
- case HBAR_CURSOR: return intern ("hbar");
- case BAR_CURSOR: return intern ("bar");
+ case HOLLOW_BOX_CURSOR: return Qhollow;
+ case HBAR_CURSOR: return Qhbar;
+ case BAR_CURSOR: return Qbar;
case NO_CURSOR:
default: return intern ("no");
}
return Qt;
}
+DEFUN ("x-frame-geometry", Fx_frame_geometry, Sx_frame_geometry, 0, 1, 0,
+ doc: /* Return geometric attributes of frame FRAME.
+
+FRAME must be a live frame and defaults to the selected one.
+
+The return value is an association list containing the following
+elements (all size values are in pixels).
+
+- `frame-outer-size' is a cons of the outer width and height of FRAME.
+ The outer size include the title bar and the external borders as well
+ as any menu and/or tool bar of frame.
+
+- `border' is a cons of the horizontal and vertical width of FRAME's
+ external borders.
+
+- `title-bar-height' is the height of the title bar of FRAME.
+
+- `menu-bar-external' if `t' means the menu bar is external (not
+ included in the inner edges of FRAME).
+
+- `menu-bar-size' is a cons of the width and height of the menu bar of
+ FRAME.
+
+- `tool-bar-external' if `t' means the tool bar is external (not
+ included in the inner edges of FRAME).
+
+- `tool-bar-side' tells tells on which side the tool bar on FRAME is and
+ can be one of `left', `top', `right' or `bottom'.
+
+- `tool-bar-size' is a cons of the width and height of the tool bar of
+ FRAME.
+
+- `frame-inner-size' is a cons of the inner width and height of FRAME.
+ This excludes FRAME's title bar and external border as well as any
+ external menu and/or tool bar. */)
+ (Lisp_Object frame)
+{
+ struct frame *f = decode_live_frame (frame);
+ int inner_width = FRAME_PIXEL_WIDTH (f);
+ int inner_height = FRAME_PIXEL_HEIGHT (f);
+ Lisp_Object fullscreen = Fframe_parameter (frame, Qfullscreen);
+ int border = f->border_width;
+ int title = FRAME_NS_TITLEBAR_HEIGHT (f);
+ int outer_width = FRAME_PIXEL_WIDTH (f) + 2 * border;
+ int outer_height = FRAME_PIXEL_HEIGHT (f) + 2 * border;
+ int tool_bar_height = FRAME_TOOLBAR_HEIGHT (f);
+ int tool_bar_width = tool_bar_height > 0
+ ? outer_width - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)
+ : 0;
+ // Always 0 on NS.
+ int menu_bar_height = 0;
+ int menu_bar_width = 0;
+
+ return
+ listn (CONSTYPE_HEAP, 10,
+ Fcons (Qframe_position,
+ Fcons (make_number (f->left_pos), make_number (f->top_pos))),
+ Fcons (Qframe_outer_size,
+ Fcons (make_number (outer_width), make_number (outer_height))),
+ Fcons (Qexternal_border_size,
+ ((EQ (fullscreen, Qfullboth) || EQ (fullscreen, Qfullscreen))
+ ? Fcons (make_number (0), make_number (0))
+ : Fcons (make_number (border), make_number (border)))),
+ Fcons (Qtitle_height,
+ ((EQ (fullscreen, Qfullboth) || EQ (fullscreen, Qfullscreen))
+ ? make_number (0)
+ : make_number (title))),
+ Fcons (Qmenu_bar_external, FRAME_EXTERNAL_MENU_BAR (f) ? Qt : Qnil),
+ Fcons (Qmenu_bar_size,
+ Fcons (make_number (menu_bar_width),
+ make_number (menu_bar_height))),
+ Fcons (Qtool_bar_external, FRAME_EXTERNAL_TOOL_BAR (f) ? Qt : Qnil),
+ Fcons (Qtool_bar_position, FRAME_TOOL_BAR_POSITION (f)),
+ Fcons (Qtool_bar_size,
+ Fcons (make_number (tool_bar_width),
+ make_number (tool_bar_height))),
+ Fcons (Qframe_inner_size,
+ Fcons (make_number (inner_width),
+ make_number (inner_height))));
+}
+
/* ==========================================================================
defsubr (&Sx_display_pixel_width);
defsubr (&Sx_display_pixel_height);
defsubr (&Sns_display_monitor_attributes_list);
+ defsubr (&Sx_frame_geometry);
defsubr (&Sx_display_mm_width);
defsubr (&Sx_display_mm_height);
defsubr (&Sx_display_screens);
#include "termhooks.h" /* For struct terminal. */
#include "font.h"
-#ifdef HAVE_XWIDGETS
-#include "xwidget.h"
-#endif
-
#include <float.h>
#include <ftoastr.h>
strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun);
PRINTCHAR ('>');
}
-#ifdef HAVE_XWIDGETS
- else if (XWIDGETP (obj))
- {
- strout ("#<xwidget ", -1, -1, printcharfun);
- PRINTCHAR ('>');
- }
- else if (XWIDGET_VIEW_P (obj))
- {
- strout ("#<xwidget-view ", -1, -1, printcharfun);
- PRINTCHAR ('>');
- }
-#endif
else if (WINDOWP (obj))
{
int len;
printcharfun);
}
PRINTCHAR ('>');
- break;
+ break;
+
+ case Lisp_Misc_Finalizer:
+ strout ("#<finalizer", -1, -1, printcharfun);
+ if (NILP (XFINALIZER (obj)->function))
+ strout (" used", -1, -1, printcharfun);
+ strout (">", -1, -1, printcharfun);
+ break;
/* Remaining cases shouldn't happen in normal usage, but let's
print them anyway for the benefit of the debugger. */
/* Number of events for which the user or sentinel has been notified. */
static EMACS_INT update_tick;
-/* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
+/* Define NON_BLOCKING_CONNECT if we can support non-blocking connects.
+ The code can be simplified by assuming NON_BLOCKING_CONNECT once
+ Emacs starts assuming POSIX 1003.1-2001 or later. */
-/* Only W32 has this, it really means that select can't take write mask. */
-#ifdef BROKEN_NON_BLOCKING_CONNECT
-#undef NON_BLOCKING_CONNECT
-enum { SELECT_CAN_DO_WRITE_MASK = false };
-#else
-enum { SELECT_CAN_DO_WRITE_MASK = true };
-#ifndef NON_BLOCKING_CONNECT
-#ifdef HAVE_SELECT
-#if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
-#if defined (EWOULDBLOCK) || defined (EINPROGRESS)
-#define NON_BLOCKING_CONNECT
-#endif /* EWOULDBLOCK || EINPROGRESS */
-#endif /* HAVE_GETPEERNAME || GNU_LINUX */
-#endif /* HAVE_SELECT */
-#endif /* NON_BLOCKING_CONNECT */
-#endif /* BROKEN_NON_BLOCKING_CONNECT */
+#if (defined HAVE_SELECT \
+ && (defined GNU_LINUX || defined HAVE_GETPEERNAME) \
+ && (defined EWOULDBLOCK || defined EINPROGRESS))
+# define NON_BLOCKING_CONNECT
+#endif
/* Define DATAGRAM_SOCKETS if datagrams can be used safely on
this system. We need to read full packets, so we need a
static void start_process_unwind (Lisp_Object proc);
-DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
+DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0,
doc: /* Start a program in a subprocess. Return the process object for it.
-NAME is name for process. It is modified if necessary to make it unique.
-BUFFER is the buffer (or buffer name) to associate with the process.
-Process output (both standard output and standard error streams) goes
-at end of BUFFER, unless you specify an output stream or filter
-function to handle the output. BUFFER may also be nil, meaning that
-this process is not associated with any buffer.
+This is similar to `start-process', but arguments are specified as
+keyword/argument pairs. The following arguments are defined:
+
+:name NAME -- NAME is name for process. It is modified if necessary
+to make it unique.
+
+:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
+with the process. Process output goes at end of that buffer, unless
+you specify an output stream or filter function to handle the output.
+BUFFER may be also nil, meaning that this process is not associated
+with any buffer.
+
+:command COMMAND -- COMMAND is a list starting with the program file
+name, followed by strings to give to the program as arguments.
-PROGRAM is the program file name. It is searched for in `exec-path'
-(which see). If nil, just associate a pty with the buffer. Remaining
-arguments are strings to give program as arguments.
+:coding CODING -- If CODING is a symbol, it specifies the coding
+system used for both reading and writing for this process. If CODING
+is a cons (DECODING . ENCODING), DECODING is used for reading, and
+ENCODING is used for writing.
-If you want to separate standard output from standard error, invoke
-the command through a shell and redirect one of them using the shell
-syntax.
+:noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
+the process is running. If BOOL is not given, query before exiting.
-usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
+:stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
+In the stopped state, a process does not accept incoming data, but you
+can send outgoing data. The stopped state is cleared by
+`continue-process' and set by `stop-process'.
+
+:connection-type TYPE -- TYPE is control type of device used to
+communicate with subprocesses. Values are `pipe' to use a pipe, `pty'
+to use a pty, or nil to use the default specified through
+`process-connection-type'.
+
+:filter FILTER -- Install FILTER as the process filter.
+
+:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
+
+usage: (make-process &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object buffer, name, program, proc, current_dir, tem;
- unsigned char **new_argv;
- ptrdiff_t i;
+ Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem;
ptrdiff_t count = SPECPDL_INDEX ();
+ struct gcpro gcpro1;
USE_SAFE_ALLOCA;
- buffer = args[1];
+ if (nargs == 0)
+ return Qnil;
+
+ /* Save arguments for process-contact and clone-process. */
+ contact = Flist (nargs, args);
+ GCPRO1 (contact);
+
+ buffer = Fplist_get (contact, QCbuffer);
if (!NILP (buffer))
buffer = Fget_buffer_create (buffer);
UNGCPRO;
}
- name = args[0];
+ name = Fplist_get (contact, QCname);
CHECK_STRING (name);
- program = args[2];
+ command = Fplist_get (contact, QCcommand);
+ if (CONSP (command))
+ program = XCAR (command);
+ else
+ program = Qnil;
if (!NILP (program))
CHECK_STRING (program);
pset_buffer (XPROCESS (proc), buffer);
pset_sentinel (XPROCESS (proc), Qinternal_default_process_sentinel);
pset_filter (XPROCESS (proc), Qinternal_default_process_filter);
- pset_command (XPROCESS (proc), Flist (nargs - 2, args + 2));
+ pset_command (XPROCESS (proc), Fcopy_sequence (command));
+
+ if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
+ XPROCESS (proc)->kill_without_query = 1;
+ if (tem = Fplist_get (contact, QCstop), !NILP (tem))
+ pset_command (XPROCESS (proc), Qt);
+
+ tem = Fplist_get (contact, QCconnection_type);
+ if (EQ (tem, Qpty))
+ XPROCESS (proc)->pty_flag = true;
+ else if (EQ (tem, Qpipe))
+ XPROCESS (proc)->pty_flag = false;
+ else if (NILP (tem))
+ XPROCESS (proc)->pty_flag = !NILP (Vprocess_connection_type);
+ else
+ report_file_error ("Unknown connection type", tem);
#ifdef HAVE_GNUTLS
/* AKA GNUTLS_INITSTAGE(proc). */
Lisp_Object val, *args2;
struct gcpro gcpro1, gcpro2;
- val = Vcoding_system_for_read;
+ tem = Fplist_get (contact, QCcoding);
+ if (!NILP (tem))
+ {
+ val = tem;
+ if (CONSP (val))
+ val = XCAR (val);
+ }
+ else
+ val = Vcoding_system_for_read;
if (NILP (val))
{
- SAFE_ALLOCA_LISP (args2, nargs + 1);
- args2[0] = Qstart_process;
- for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
+ ptrdiff_t nargs2 = 3 + XINT (Flength (command));
+ Lisp_Object tem2;
+ SAFE_ALLOCA_LISP (args2, nargs2);
+ ptrdiff_t i = 0;
+ args2[i++] = Qstart_process;
+ args2[i++] = name;
+ args2[i++] = buffer;
+ for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
+ args2[i++] = XCAR (tem2);
GCPRO2 (proc, current_dir);
if (!NILP (program))
- coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
+ coding_systems = Ffind_operation_coding_system (nargs2, args2);
UNGCPRO;
if (CONSP (coding_systems))
val = XCAR (coding_systems);
}
pset_decode_coding_system (XPROCESS (proc), val);
- val = Vcoding_system_for_write;
+ if (!NILP (tem))
+ {
+ val = tem;
+ if (CONSP (val))
+ val = XCDR (val);
+ }
+ else
+ val = Vcoding_system_for_write;
if (NILP (val))
{
if (EQ (coding_systems, Qt))
{
- SAFE_ALLOCA_LISP (args2, nargs + 1);
- args2[0] = Qstart_process;
- for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
+ ptrdiff_t nargs2 = 3 + XINT (Flength (command));
+ Lisp_Object tem2;
+ SAFE_ALLOCA_LISP (args2, nargs2);
+ ptrdiff_t i = 0;
+ args2[i++] = Qstart_process;
+ args2[i++] = name;
+ args2[i++] = buffer;
+ for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
+ args2[i++] = XCAR (tem2);
GCPRO2 (proc, current_dir);
if (!NILP (program))
- coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
+ coding_systems = Ffind_operation_coding_system (nargs2, args2);
UNGCPRO;
}
if (CONSP (coding_systems))
if (!NILP (program))
{
+ Lisp_Object program_args = XCDR (command);
+
/* If program file name is not absolute, search our path for it.
Put the name we will really use in TEM. */
if (!IS_DIRECTORY_SEP (SREF (program, 0))
&& !(SCHARS (program) > 1
&& IS_DEVICE_SEP (SREF (program, 1))))
{
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ struct gcpro gcpro1, gcpro2;
tem = Qnil;
- GCPRO4 (name, program, buffer, current_dir);
+ GCPRO2 (buffer, current_dir);
openp (Vexec_path, program, Vexec_suffixes, &tem,
make_number (X_OK), false);
UNGCPRO;
/* Remove "/:" from TEM. */
tem = remove_slash_colon (tem);
- {
- Lisp_Object arg_encoding = Qnil;
- struct gcpro gcpro1;
- GCPRO1 (tem);
+ Lisp_Object arg_encoding = Qnil;
+ struct gcpro gcpro1;
+ GCPRO1 (tem);
- /* Encode the file name and put it in NEW_ARGV.
- That's where the child will use it to execute the program. */
- tem = list1 (ENCODE_FILE (tem));
+ /* Encode the file name and put it in NEW_ARGV.
+ That's where the child will use it to execute the program. */
+ tem = list1 (ENCODE_FILE (tem));
+ ptrdiff_t new_argc = 1;
- /* Here we encode arguments by the coding system used for sending
- data to the process. We don't support using different coding
- systems for encoding arguments and for encoding data sent to the
- process. */
+ /* Here we encode arguments by the coding system used for sending
+ data to the process. We don't support using different coding
+ systems for encoding arguments and for encoding data sent to the
+ process. */
- for (i = 3; i < nargs; i++)
- {
- tem = Fcons (args[i], tem);
- CHECK_STRING (XCAR (tem));
- if (STRING_MULTIBYTE (XCAR (tem)))
- {
- if (NILP (arg_encoding))
- arg_encoding = (complement_process_encoding_system
- (XPROCESS (proc)->encode_coding_system));
- XSETCAR (tem,
- code_convert_string_norecord
- (XCAR (tem), arg_encoding, 1));
- }
- }
+ for (Lisp_Object tem2 = program_args; CONSP (tem2); tem2 = XCDR (tem2))
+ {
+ Lisp_Object arg = XCAR (tem2);
+ CHECK_STRING (arg);
+ if (STRING_MULTIBYTE (arg))
+ {
+ if (NILP (arg_encoding))
+ arg_encoding = (complement_process_encoding_system
+ (XPROCESS (proc)->encode_coding_system));
+ arg = code_convert_string_norecord (arg, arg_encoding, 1);
+ }
+ tem = Fcons (arg, tem);
+ new_argc++;
+ }
- UNGCPRO;
- }
+ UNGCPRO;
/* Now that everything is encoded we can collect the strings into
NEW_ARGV. */
- SAFE_NALLOCA (new_argv, 1, nargs - 1);
- new_argv[nargs - 2] = 0;
+ char **new_argv;
+ SAFE_NALLOCA (new_argv, 1, new_argc + 1);
+ new_argv[new_argc] = 0;
- for (i = nargs - 2; i-- != 0; )
+ for (ptrdiff_t i = new_argc - 1; i >= 0; i--)
{
- new_argv[i] = SDATA (XCAR (tem));
+ new_argv[i] = SSDATA (XCAR (tem));
tem = XCDR (tem);
}
- create_process (proc, (char **) new_argv, current_dir);
+ create_process (proc, new_argv, current_dir);
}
else
create_pty (proc);
+ UNGCPRO;
SAFE_FREE ();
return unbind_to (count, proc);
}
inchannel = outchannel = -1;
- if (!NILP (Vprocess_connection_type))
+ if (p->pty_flag)
outchannel = inchannel = allocate_pty (pty_name);
if (inchannel >= 0)
p->pty_flag = pty_flag;
pset_status (p, Qrun);
- FD_SET (inchannel, &input_wait_mask);
- FD_SET (inchannel, &non_keyboard_wait_mask);
+ if (!EQ (p->command, Qt))
+ {
+ FD_SET (inchannel, &input_wait_mask);
+ FD_SET (inchannel, &non_keyboard_wait_mask);
+ }
+
if (inchannel > max_process_desc)
max_process_desc = inchannel;
{
struct Lisp_Process *p = XPROCESS (process);
char pty_name[PTY_NAME_SIZE];
- int pty_fd = NILP (Vprocess_connection_type) ? -1 : allocate_pty (pty_name);
+ int pty_fd = !p->pty_flag ? -1 : allocate_pty (pty_name);
if (pty_fd >= 0)
{
Available = input_wait_mask;
Writeok = write_mask;
check_delay = wait_proc ? 0 : process_output_delay_count;
- check_write = SELECT_CAN_DO_WRITE_MASK;
+ check_write = true;
}
/* If frame size has changed or the window is newly mapped,
DEFUN ("process-running-child-p", Fprocess_running_child_p,
Sprocess_running_child_p, 0, 1, 0,
- doc: /* Return t if PROCESS has given the terminal to a child.
-If the operating system does not make it possible to find out,
-return t unconditionally. */)
+ doc: /* Return non-nil if PROCESS has given the terminal to a
+child. If the operating system does not make it possible to find out,
+return t. If we can find out, return the numeric ID of the foreground
+process group. */)
(Lisp_Object process)
{
/* Initialize in case ioctl doesn't exist or gives an error,
if (gid == p->pid)
return Qnil;
+ if (gid != -1)
+ return make_number (gid);
return Qt;
}
\f
DEFSYM (QCstop, ":stop");
DEFSYM (QCoptions, ":options");
DEFSYM (QCplist, ":plist");
+ DEFSYM (QCcommand, ":command");
+ DEFSYM (QCconnection_type, ":connection-type");
+ DEFSYM (Qpty, "pty");
+ DEFSYM (Qpipe, "pipe");
DEFSYM (Qlast_nonmenu_event, "last-nonmenu-event");
defsubr (&Sprocess_plist);
defsubr (&Sset_process_plist);
defsubr (&Sprocess_list);
- defsubr (&Sstart_process);
+ defsubr (&Smake_process);
defsubr (&Sserial_process_configure);
defsubr (&Smake_serial_process);
defsubr (&Sset_network_process_option);
? (((c) >= 'a' && (c) <= 'z') \
|| ((c) >= 'A' && (c) <= 'Z') \
|| ((c) >= '0' && (c) <= '9')) \
- : SYNTAX (c) == Sword)
+ : (alphabeticp (c) || decimalnump (c)))
# define ISALPHA(c) (IS_REAL_ASCII (c) \
? (((c) >= 'a' && (c) <= 'z') \
|| ((c) >= 'A' && (c) <= 'Z')) \
- : SYNTAX (c) == Sword)
+ : alphabeticp (c))
# define ISLOWER(c) lowercasep (c)
#define BIT_SPACE 0x8
#define BIT_UPPER 0x10
#define BIT_MULTIBYTE 0x20
+#define BIT_ALPHA 0x40
+#define BIT_ALNUM 0x80
\f
/* Set the bit for character C in a list. */
{
case RECC_NONASCII: case RECC_PRINT: case RECC_GRAPH:
case RECC_MULTIBYTE: return BIT_MULTIBYTE;
- case RECC_ALPHA: case RECC_ALNUM: case RECC_WORD: return BIT_WORD;
+ case RECC_ALPHA: return BIT_ALPHA;
+ case RECC_ALNUM: return BIT_ALNUM;
+ case RECC_WORD: return BIT_WORD;
case RECC_LOWER: return BIT_LOWER;
case RECC_UPPER: return BIT_UPPER;
case RECC_PUNCT: return BIT_PUNCT;
#endif /* emacs */
/* In most cases the matching rule for char classes
only uses the syntax table for multibyte chars,
- so that the content of the syntax-table it is not
+ so that the content of the syntax-table is not
hardcoded in the range_table. SPACE and WORD are
the two exceptions. */
if ((1 << cc) & ((1 << RECC_SPACE) | (1 << RECC_WORD)))
p = class_beg;
SET_LIST_BIT ('[');
- /* Because the `:' may starts the range, we
+ /* Because the `:' may start the range, we
can't simply set bit and repeat the loop.
Instead, just set it to C and handle below. */
c = ':';
| (class_bits & BIT_PUNCT && ISPUNCT (c))
| (class_bits & BIT_SPACE && ISSPACE (c))
| (class_bits & BIT_UPPER && ISUPPER (c))
- | (class_bits & BIT_WORD && ISWORD (c)))
+ | (class_bits & BIT_WORD && ISWORD (c))
+ | (class_bits & BIT_ALPHA && ISALPHA (c))
+ | (class_bits & BIT_ALNUM && ISALNUM (c)))
not = !not;
else
CHARSET_LOOKUP_RANGE_TABLE_RAW (not, c, range_table, count);
start, &next_change);
if (result)
{
+ /* When the cache revalidation is deferred,
+ next-change might point beyond ZV, which will
+ cause assertion violation in CHAR_TO_BYTE below.
+ Limit next_change to ZV to avoid that. */
+ if (next_change > ZV)
+ next_change = ZV;
start = next_change;
lim1 = next_change = end;
}
/* 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. */
+ not invoke async-unsafe functions like malloc.
+
+ If BACKTRACE_LIMIT is -1, initialize tables that 'backtrace' uses
+ but do not output anything. This avoids some problems that can
+ otherwise occur if the malloc arena is corrupted before 'backtrace'
+ is called, since 'backtrace' may call malloc if the tables are not
+ initialized.
+
+ If the static variable THREAD_BACKTRACE_NPOINTERS is nonzero, a
+ fatal error has occurred in some other thread; generate a thread
+ backtrace instead, ignoring BACKTRACE_LIMIT. */
void
emacs_backtrace (int backtrace_limit)
{
else
{
buffer = main_backtrace_buffer;
+
+ /* Work around 'backtrace' bug; see Bug#19959 and glibc bug#18084. */
+ if (bounded_limit < 0)
+ {
+ backtrace (buffer, 1);
+ return;
+ }
+
npointers = backtrace (buffer, bounded_limit + 1);
}
+/* Standard I/O for Emacs.
+
+Copyright 2013-2015 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 <fcntl.h>
#include <stdio.h>
+
extern FILE *emacs_fopen (char const *, char const *);
+
+#if O_BINARY
+# define FOPEN_BINARY "b"
+# define FOPEN_TEXT "t"
+#else
+# define FOPEN_BINARY ""
+# define FOPEN_TEXT ""
+#endif
/* defined in editfns.c */
extern Lisp_Object make_lisp_time (struct timespec);
-extern bool decode_time_components (Lisp_Object, Lisp_Object, Lisp_Object,
- Lisp_Object, struct lisp_time *, double *);
+extern int decode_time_components (Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object, struct lisp_time *, double *);
extern struct timespec lisp_to_timespec (struct lisp_time);
extern struct timespec lisp_time_argument (Lisp_Object);
#endif
typedef char const *timezone_t;
INLINE timezone_t tzalloc (char const *name) { return name; }
INLINE void tzfree (timezone_t tz) { }
-/* Defined in editfns.c. */
-extern time_t mktime_z (timezone_t, struct tm *);
#endif
INLINE_HEADER_END
, NS_NONKEY_EVENT
#endif
-#ifdef HAVE_XWIDGETS
- /* events generated by xwidgets*/
- , XWIDGET_EVENT
-#endif
#ifdef USE_FILE_NOTIFY
/* File or directory was changed. */
, FILE_NOTIFY_EVENT
/* Text properties `syntax-table'and `display' should be nonsticky
by default. */
Vtext_property_default_nonsticky
- = list2 (Fcons (intern_c_string ("syntax-table"), Qt),
- Fcons (intern_c_string ("display"), Qt));
+ = list2 (Fcons (Qsyntax_table, Qt), Fcons (Qdisplay, Qt));
staticpro (&interval_insert_behind_hooks);
staticpro (&interval_insert_in_front_hooks);
break;
case ERROR_PATH_NOT_FOUND:
case ERROR_INVALID_DRIVE:
+ case ERROR_NOT_READY:
case ERROR_BAD_NETPATH:
case ERROR_BAD_NET_NAME:
errno = ENOENT;
void (PASCAL *pfn_WSASetLastError) (int iError);
int (PASCAL *pfn_WSAGetLastError) (void);
int (PASCAL *pfn_WSAEventSelect) (SOCKET s, HANDLE hEventObject, long lNetworkEvents);
+int (PASCAL *pfn_WSAEnumNetworkEvents) (SOCKET s, HANDLE hEventObject,
+ WSANETWORKEVENTS *NetworkEvents);
+
HANDLE (PASCAL *pfn_WSACreateEvent) (void);
int (PASCAL *pfn_WSACloseEvent) (HANDLE hEvent);
int (PASCAL *pfn_socket) (int af, int type, int protocol);
LOAD_PROC (WSASetLastError);
LOAD_PROC (WSAGetLastError);
LOAD_PROC (WSAEventSelect);
+ LOAD_PROC (WSAEnumNetworkEvents);
LOAD_PROC (WSACreateEvent);
LOAD_PROC (WSACloseEvent);
LOAD_PROC (socket);
case WSAEMFILE: errno = EMFILE; break;
case WSAENAMETOOLONG: errno = ENAMETOOLONG; break;
case WSAENOTEMPTY: errno = ENOTEMPTY; break;
+ case WSAEWOULDBLOCK: errno = EWOULDBLOCK; break;
+ case WSAENOTCONN: errno = ENOTCONN; break;
default: errno = wsa_err; break;
}
}
{
int rc = pfn_connect (SOCK_HANDLE (s), name, namelen);
if (rc == SOCKET_ERROR)
- set_errno ();
+ {
+ set_errno ();
+ /* If this is a non-blocking 'connect', set the bit in flags
+ that will tell reader_thread to wait for connection
+ before trying to read. */
+ if (errno == EWOULDBLOCK && (fd_info[s].flags & FILE_NDELAY) != 0)
+ {
+ errno = EINPROGRESS; /* that's what process.c expects */
+ fd_info[s].flags |= FILE_CONNECT;
+ }
+ }
return rc;
}
errno = ENOTSOCK;
emacs_abort ();
}
+ if ((fd_info[fd].flags & FILE_CONNECT) != 0)
+ DebPrint (("_sys_read_ahead: read requested from fd %d, which waits for async connect!\n", fd));
cp->status = STATUS_READ_IN_PROGRESS;
if (fd_info[fd].flags & FILE_PIPE)
return cp->status;
}
+int
+_sys_wait_connect (int fd)
+{
+ HANDLE hEv;
+ child_process * cp;
+ int rc;
+
+ if (fd < 0 || fd >= MAXDESC)
+ return STATUS_READ_ERROR;
+
+ cp = fd_info[fd].cp;
+ if (cp == NULL || cp->fd != fd || cp->status != STATUS_READ_READY)
+ return STATUS_READ_ERROR;
+
+ cp->status = STATUS_READ_FAILED;
+
+ hEv = pfn_WSACreateEvent ();
+ rc = pfn_WSAEventSelect (SOCK_HANDLE (fd), hEv, FD_CONNECT);
+ if (rc != SOCKET_ERROR)
+ {
+ do {
+ rc = WaitForSingleObject (hEv, 500);
+ Sleep (5);
+ } while (rc == WAIT_TIMEOUT
+ && cp->status != STATUS_READ_ERROR
+ && cp->char_avail);
+ if (rc == WAIT_OBJECT_0)
+ {
+ /* We've got an event, but it could be a successful
+ connection, or it could be a failure. Find out
+ which one is it. */
+ WSANETWORKEVENTS events;
+
+ pfn_WSAEnumNetworkEvents (SOCK_HANDLE (fd), hEv, &events);
+ if ((events.lNetworkEvents & FD_CONNECT) != 0
+ && events.iErrorCode[FD_CONNECT_BIT])
+ {
+ cp->status = STATUS_CONNECT_FAILED;
+ cp->errcode = events.iErrorCode[FD_CONNECT_BIT];
+ }
+ else
+ {
+ cp->status = STATUS_READ_SUCCEEDED;
+ cp->errcode = 0;
+ }
+ }
+ pfn_WSAEventSelect (SOCK_HANDLE (fd), NULL, 0);
+ }
+ else
+ pfn_WSACloseEvent (hEv);
+
+ return cp->status;
+}
+
int
sys_read (int fd, char * buffer, unsigned int count)
{
ResetEvent (cp->char_avail);
case STATUS_READ_ACKNOWLEDGED:
+ case STATUS_CONNECT_FAILED:
break;
default:
{
if (winsock_lib == NULL) emacs_abort ();
- /* do the equivalent of a non-blocking read */
+ /* When a non-blocking 'connect' call fails,
+ wait_reading_process_output detects this by calling
+ 'getpeername', and then attempts to obtain the connection
+ error code by trying to read 1 byte from the socket. If
+ we try to serve that read by calling 'recv' below, the
+ error we get is a generic WSAENOTCONN, not the actual
+ connection error. So instead, we use the actual error
+ code stashed by '_sys_wait_connect' in cp->errcode.
+ Alternatively, we could have used 'getsockopt', like on
+ GNU/Linux, but: (a) I have no idea whether the winsock
+ version could hang, as it does "on some systems" (see the
+ comment in process.c); and (b) 'getsockopt' on Windows is
+ documented to clear the socket error for the entire
+ process, which I'm not sure is TRT; FIXME. */
+ if (current_status == STATUS_CONNECT_FAILED
+ && (fd_info[fd].flags & FILE_CONNECT) != 0
+ && cp->errcode != 0)
+ {
+ pfn_WSASetLastError (cp->errcode);
+ set_errno ();
+ return -1;
+ }
+ /* Do the equivalent of a non-blocking read. */
pfn_ioctlsocket (SOCK_HANDLE (fd), FIONREAD, &waiting);
if (waiting == 0 && nchars == 0)
{
int res = pfn_recv (SOCK_HANDLE (fd), buffer, count, 0);
if (res == SOCKET_ERROR)
{
- DebPrint (("sys_read.recv failed with error %d on socket %ld\n",
- pfn_WSAGetLastError (), SOCK_HANDLE (fd)));
set_errno ();
+ DebPrint (("sys_read.recv failed with error %d on socket %ld\n",
+ errno, SOCK_HANDLE (fd)));
return -1;
}
nchars += res;
STATUS_READ_IN_PROGRESS,
STATUS_READ_FAILED,
STATUS_READ_SUCCEEDED,
- STATUS_READ_ACKNOWLEDGED
+ STATUS_READ_ACKNOWLEDGED,
+ STATUS_CONNECT_FAILED
};
/* This structure is used for both pipes and sockets; for
/* Status of subprocess/connection and of reading its output. For
values, see the enumeration above. */
volatile int status;
+ /* Used to store errno value of failed async 'connect' calls. */
+ volatile int errcode;
/* Holds a single character read by _sys_read_ahead, when a
subprocess has some output ready. */
char chr;
/* fd_info flag definitions */
#define FILE_READ 0x0001
#define FILE_WRITE 0x0002
-#define FILE_LISTEN 0x0004
+#define FILE_LISTEN 0x0004
+#define FILE_CONNECT 0x0008
#define FILE_BINARY 0x0010
#define FILE_LAST_CR 0x0020
#define FILE_AT_EOF 0x0040
extern int _sys_read_ahead (int fd);
extern int _sys_wait_accept (int fd);
+extern int _sys_wait_connect (int fd);
extern HMODULE w32_delayed_load (Lisp_Object);
typedef LONG (WINAPI * ImmGetCompositionString_Proc)
(IN HIMC context, IN DWORD index, OUT LPVOID buffer, IN DWORD bufLen);
typedef HIMC (WINAPI * ImmGetContext_Proc) (IN HWND window);
-typedef HWND (WINAPI * ImmReleaseContext_Proc) (IN HWND wnd, IN HIMC context);
-typedef HWND (WINAPI * ImmSetCompositionWindow_Proc) (IN HIMC context,
+typedef BOOL (WINAPI * ImmReleaseContext_Proc) (IN HWND wnd, IN HIMC context);
+typedef BOOL (WINAPI * ImmSetCompositionWindow_Proc) (IN HIMC context,
IN COMPOSITIONFORM *form);
typedef HMONITOR (WINAPI * MonitorFromPoint_Proc) (IN POINT pt, IN DWORD flags);
typedef BOOL (WINAPI * GetMonitorInfo_Proc)
/* Convert (0, 0) in the client area to screen co-ordinates. */
ClientToScreen (FRAME_W32_WINDOW (f), &pt);
- /* Remember x_pixels_diff and y_pixels_diff. */
- f->x_pixels_diff = pt.x - rect.left;
- f->y_pixels_diff = pt.y - rect.top;
-
*xptr = rect.left;
*yptr = rect.top;
}
int old_height = FRAME_TOOL_BAR_HEIGHT (f);
int lines = (height + unit - 1) / unit;
int old_text_height = FRAME_TEXT_HEIGHT (f);
+ Lisp_Object fullscreen;
/* Make sure we redisplay all windows in this frame. */
windows_or_buffers_changed = 23;
f->n_tool_bar_rows = 0;
adjust_frame_size (f, -1, -1,
- (!f->tool_bar_redisplayed_once ? 1
+ ((!f->tool_bar_redisplayed_once
+ && (NILP (fullscreen =
+ get_frame_param (f, Qfullscreen))
+ || EQ (fullscreen, Qfullwidth))) ? 1
: (old_height == 0 || height == 0) ? 2
: 4),
false, Qtool_bar_lines);
field being reset to nil. */
f = x_window_to_frame (dpyinfo, hwnd);
if (!(f && FRAME_LIVE_P (f)))
- break;
+ goto dflt;
w = XWINDOW (FRAME_SELECTED_WINDOW (f));
/* Punt if someone changed the frame's selected window
behind our back. */
if (w != w32_system_caret_window)
- break;
+ goto dflt;
form.dwStyle = CFS_RECT;
form.ptCurrentPos.x = w32_system_caret_x;
/* Punt if the window was deleted behind our back. */
if (!BUFFERP (w->contents))
- break;
+ goto dflt;
context = get_ime_context_fn (hwnd);
if (!context)
- break;
+ goto dflt;
set_ime_composition_window_fn (context, &form);
release_ime_context_fn (hwnd, context);
}
+ /* We should "goto dflt" here to pass WM_IME_STARTCOMPOSITION to
+ DefWindowProc, so that the composition window will actually
+ be displayed. But doing so causes trouble with displaying
+ dialog boxes, such as the file selection dialog or font
+ selection dialog. So something else is needed to fix the
+ former without breaking the latter. See bug#11732. */
break;
case WM_IME_ENDCOMPOSITION:
"bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL);
x_default_parameter (f, parameters, Qtitle, Qnil,
"title", "Title", RES_TYPE_STRING);
- x_default_parameter (f, parameters, Qfullscreen, Qnil,
- "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
f->output_data.w32->dwStyle = WS_OVERLAPPEDWINDOW;
f->output_data.w32->parent_desc = FRAME_DISPLAY_INFO (f)->root_window;
x_wm_set_size_hint (f, window_prompting, false);
unblock_input ();
+ /* Process fullscreen parameter here in the hope that normalizing a
+ fullheight/fullwidth frame will produce the size set by the last
+ adjust_frame_size call. */
+ x_default_parameter (f, parameters, Qfullscreen, Qnil,
+ "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
+
/* Make the window appear on the frame and enable display, unless
the caller says not to. However, with explicit parent, Emacs
cannot control visibility, so don't try. */
SET_FRAME_COLS (f, 0);
SET_FRAME_LINES (f, 0);
adjust_frame_size (f, width * FRAME_COLUMN_WIDTH (f),
- height * FRAME_LINE_HEIGHT (f), 0, true, Qnil);
+ height * FRAME_LINE_HEIGHT (f), 0, true, Qtip_frame);
/* Add `tooltip' frame parameter's default value. */
if (NILP (Fframe_parameter (frame, Qtooltip)))
menu_bar_height = single_bar_height;
return
- listn (CONSTYPE_PURE, 10,
+ listn (CONSTYPE_HEAP, 10,
Fcons (Qframe_position,
Fcons (make_number (frame_outer_edges.left),
make_number (frame_outer_edges.top))),
MessageBeep (sound_type);
}
+DEFUN ("w32--menu-bar-in-use", Fw32__menu_bar_in_use, Sw32__menu_bar_in_use,
+ 0, 0, 0,
+ doc: /* Return non-nil when a menu-bar menu is being used.
+Internal use only. */)
+ (void)
+{
+ return menubar_in_use ? Qt : Qnil;
+}
+
\f
/***********************************************************************
Initialization
defsubr (&Sw32_frame_rect);
defsubr (&Sw32_frame_menu_bar_size);
defsubr (&Sw32_battery_status);
+ defsubr (&Sw32__menu_bar_in_use);
#ifdef WINDOWSNT
defsubr (&Sfile_system_info);
truetype so that this information is not any worse than we could
have obtained later. */
if (EQ (backend, Quniscribe) && (full_type & NTMFLAGS_OPENTYPE))
- tem = intern ("opentype");
+ tem = Qopentype;
else if (font_type & TRUETYPE_FONTTYPE)
tem = intern ("truetype");
else if (full_type & NTM_PS_OPENTYPE)
- tem = intern ("postscript");
+ tem = Qpostscript;
else if (full_type & NTM_TYPE1)
tem = intern ("type1");
else if (font_type & RASTER_FONTTYPE)
w32_to_fc_weight (int n)
{
if (n >= FW_EXTRABOLD) return intern ("black");
- if (n >= FW_BOLD) return intern ("bold");
+ if (n >= FW_BOLD) return Qbold;
if (n >= FW_SEMIBOLD) return intern ("demibold");
if (n >= FW_NORMAL) return intern ("medium");
- return intern ("light");
+ return Qlight;
}
/* Fill in all the available details of LOGFONT from FONT_SPEC. */
supported = Fcons ((sym), supported)
SUBRANGE (0, Qlatin);
- /* The following count as latin too, ASCII should be present in these fonts,
- so don't need to mark them separately. */
/* 1: Latin-1 supplement, 2: Latin Extended A, 3: Latin Extended B. */
+ /* Most fonts that support Latin will have good coverage of the
+ Extended blocks, so in practice marking them below is not really
+ needed, or useful: if a font claims support for, say, Latin
+ Extended-B, but does not contain glyphs for some of the
+ characters in the range, the user will have to augment her
+ fontset to display those few characters. But we mark these
+ subranges here anyway, for the marginal use cases where they
+ might make a difference. */
+ SUBRANGE (1, Qlatin);
+ SUBRANGE (2, Qlatin);
+ SUBRANGE (3, Qlatin);
SUBRANGE (4, Qphonetic);
/* 5: Spacing and tone modifiers, 6: Combining Diacritical Marks. */
SUBRANGE (7, Qgreek);
SUBRANGE (9, Qcyrillic);
SUBRANGE (10, Qarmenian);
SUBRANGE (11, Qhebrew);
- /* 12: Vai. */
+ /* Bit 12 is rather useless if the user has Hebrew fonts installed,
+ because apparently at some point in the past bit 12 was "Hebrew
+ Extended", and many Hebrew fonts still have this bit set. The
+ only workaround is to customize fontsets to use fonts like Ebrima
+ or Quivira. */
+ SUBRANGE (12, Qvai);
SUBRANGE (13, Qarabic);
SUBRANGE (14, Qnko);
SUBRANGE (15, Qdevanagari);
SUBRANGE (25, Qlao);
SUBRANGE (26, Qgeorgian);
SUBRANGE (27, Qbalinese);
- /* 28: Hangul Jamo. */
- /* 29: Latin Extended, 30: Greek Extended, 31: Punctuation. */
+ /* 28: Hangul Jamo -- covered by the default fontset. */
+ /* 29: Latin Extended, 30: Greek Extended -- covered above. */
+ /* 31: Supplemental Punctuation -- most probably be masked by
+ Courier New, so fontset customization is needed. */
+ SUBRANGE (31, Qsymbol);
/* 32-47: Symbols (defined below). */
SUBRANGE (48, Qcjk_misc);
/* Match either 49: katakana or 50: hiragana for kana. */
SUBRANGE (59, Qhan); /* There are others, but this is the main one. */
SUBRANGE (59, Qideographic_description); /* Windows lumps this in. */
SUBRANGE (59, Qkanbun); /* And this. */
+ /* These are covered well either by the default Courier New or by
+ CJK fonts that are set up specially in the default fontset. So
+ marking them here wouldn't be useful. */
/* 60: Private use, 61: CJK strokes and compatibility. */
/* 62: Alphabetic Presentation, 63: Arabic Presentation A. */
/* 64: Combining half marks, 65: Vertical and CJK compatibility. */
SUBRANGE (87, Qdeseret);
SUBRANGE (88, Qbyzantine_musical_symbol);
SUBRANGE (88, Qmusical_symbol); /* Windows doesn't distinguish these. */
- SUBRANGE (89, Qmathematical);
+ SUBRANGE (89, Qmathematical_bold); /* See fontset.el:setup-default-fontset. */
+ SUBRANGE (89, Qmathematical_italic);
+ SUBRANGE (89, Qmathematical_bold_italic);
+ SUBRANGE (89, Qmathematical_script);
+ SUBRANGE (89, Qmathematical_bold_script);
+ SUBRANGE (89, Qmathematical_fraktur);
+ SUBRANGE (89, Qmathematical_double_struck);
+ SUBRANGE (89, Qmathematical_bold_fraktur);
+ SUBRANGE (89, Qmathematical_sans_serif);
+ SUBRANGE (89, Qmathematical_sans_serif_bold);
+ SUBRANGE (89, Qmathematical_sans_serif_italic);
+ SUBRANGE (89, Qmathematical_sans_serif_bold_italic);
+ SUBRANGE (89, Qmathematical_monospace);
/* 90: Private use, 91: Variation selectors, 92: Tags. */
SUBRANGE (93, Qlimbu);
SUBRANGE (94, Qtai_le);
- /* 95: New Tai Le */
- SUBRANGE (90, Qbuginese);
+ SUBRANGE (95, Qtai_le);
+ SUBRANGE (96, Qbuginese);
SUBRANGE (97, Qglagolitic);
SUBRANGE (98, Qtifinagh);
/* 99: Yijing Hexagrams. */
+ SUBRANGE (99, Qhan);
SUBRANGE (100, Qsyloti_nagri);
SUBRANGE (101, Qlinear_b);
- /* 102: Ancient Greek Numbers. */
+ SUBRANGE (102, Qancient_greek_number);
SUBRANGE (103, Qugaritic);
SUBRANGE (104, Qold_persian);
SUBRANGE (105, Qshavian);
SUBRANGE (106, Qosmanya);
SUBRANGE (107, Qcypriot);
SUBRANGE (108, Qkharoshthi);
- /* 109: Tai Xuan Jing. */
+ SUBRANGE (109, Qtai_xuan_jing_symbol);
SUBRANGE (110, Qcuneiform);
- /* 111: Counting Rods, 112: Sundanese, 113: Lepcha, 114: Ol Chiki. */
- /* 115: Saurashtra, 116: Kayah Li, 117: Rejang. */
+ SUBRANGE (111, Qcounting_rod_numeral);
+ SUBRANGE (112, Qsundanese);
+ SUBRANGE (113, Qlepcha);
+ SUBRANGE (114, Qol_chiki);
+ SUBRANGE (115, Qsaurashtra);
+ SUBRANGE (116, Qkayah_li);
+ SUBRANGE (117, Qrejang);
SUBRANGE (118, Qcham);
- /* 119: Ancient symbols, 120: Phaistos Disc. */
- /* 121: Carian, Lycian, Lydian, 122: Dominoes, Mahjong tiles. */
+ SUBRANGE (119, Qancient_symbol);
+ SUBRANGE (120, Qphaistos_disc);
+ SUBRANGE (121, Qlycian);
+ SUBRANGE (121, Qcarian);
+ SUBRANGE (121, Qlydian);
+ SUBRANGE (122, Qdomino_tile);
+ SUBRANGE (122, Qmahjong_tile);
/* 123-127: Reserved. */
/* There isn't really a main symbol range, so include symbol if any
DEFSYM (Qcyrillic, "cyrillic");
DEFSYM (Qarmenian, "armenian");
DEFSYM (Qhebrew, "hebrew");
+ DEFSYM (Qvai, "vai");
DEFSYM (Qarabic, "arabic");
DEFSYM (Qsyriac, "syriac");
DEFSYM (Qnko, "nko");
DEFSYM (Qyi, "yi");
DEFSYM (Qbyzantine_musical_symbol, "byzantine-musical-symbol");
DEFSYM (Qmusical_symbol, "musical-symbol");
- DEFSYM (Qmathematical, "mathematical");
+ DEFSYM (Qmathematical_bold, "mathematical-bold");
+ DEFSYM (Qmathematical_italic, "mathematical-italic");
+ DEFSYM (Qmathematical_bold_italic, "mathematical-bold-italic");
+ DEFSYM (Qmathematical_script, "mathematical-script");
+ DEFSYM (Qmathematical_bold_script, "mathematical-bold-script");
+ DEFSYM (Qmathematical_fraktur, "mathematical-fraktur");
+ DEFSYM (Qmathematical_double_struck, "mathematical-double-struck");
+ DEFSYM (Qmathematical_bold_fraktur, "mathematical-bold-fraktur");
+ DEFSYM (Qmathematical_sans_serif, "mathematical-sans-serif");
+ DEFSYM (Qmathematical_sans_serif_bold, "mathematical-sans-serif-bold");
+ DEFSYM (Qmathematical_sans_serif_italic, "mathematical-sans-serif-italic");
+ DEFSYM (Qmathematical_sans_serif_bold_italic, "mathematical-sans-serif-bold-italic");
+ DEFSYM (Qmathematical_monospace, "mathematical-monospace");
DEFSYM (Qcham, "cham");
DEFSYM (Qphonetic, "phonetic");
DEFSYM (Qbalinese, "balinese");
DEFSYM (Qtai_le, "tai_le");
DEFSYM (Qtifinagh, "tifinagh");
DEFSYM (Qugaritic, "ugaritic");
+ DEFSYM (Qlycian, "lycian");
+ DEFSYM (Qcarian, "carian");
+ DEFSYM (Qlydian, "lydian");
+ DEFSYM (Qdomino_tile, "domino-tile");
+ DEFSYM (Qmahjong_tile, "mahjong-tile");
+ DEFSYM (Qtai_xuan_jing_symbol, "tai-xuan-jing-symbol");
+ DEFSYM (Qcounting_rod_numeral, "counting-rod-numeral");
+ DEFSYM (Qancient_symbol, "ancient-symbol");
+ DEFSYM (Qphaistos_disc, "phaistos-disc");
+ DEFSYM (Qancient_greek_number, "ancient-greek-number");
+ DEFSYM (Qsundanese, "sundanese");
+ DEFSYM (Qlepcha, "lepcha");
+ DEFSYM (Qol_chiki, "ol-chiki");
+ DEFSYM (Qsaurashtra, "saurashtra");
+ DEFSYM (Qkayah_li, "kayah-li");
+ DEFSYM (Qrejang, "rejang");
/* W32 font encodings. */
DEFVAR_LISP ("w32-charset-info-alist",
if (notification_buffer_in_use)
{
DWORD info_size = notifications_size;
- Lisp_Object cs = intern ("utf-16le");
+ Lisp_Object cs = Qutf_16le;
Lisp_Object obj = w32_get_watch_object (notifications_desc);
/* notifications_size could be zero when the buffer of
#endif
}
+\f
+
+/* Here's an overview of how support for subprocesses and
+ network/serial streams is implemented on MS-Windows.
+
+ The management of both subprocesses and network/serial streams
+ circles around the child_procs[] array, which can record up to the
+ grand total of MAX_CHILDREN (= 32) of these. (The reasons for the
+ 32 limitation will become clear below.) Each member of
+ child_procs[] is a child_process structure, defined on w32.h.
+
+ A related data structure is the fd_info[] array, which holds twice
+ as many members, 64, and records the information about file
+ descriptors used for communicating with subprocesses and
+ network/serial devices. Each member of the array is the filedesc
+ structure, which records the Windows handle for communications,
+ such as the read end of the pipe to a subprocess, a socket handle,
+ etc.
+
+ Both these arrays reference each other: there's a member of
+ child_process structure that records the file corresponding
+ descriptor, and there's a member of filedesc structure that holds a
+ pointer to the corresponding child_process.
+
+ Whenever Emacs starts a subprocess or opens a network/serial
+ stream, the function new_child is called to prepare a new
+ child_process structure. new_child looks for the first vacant slot
+ in the child_procs[] array, initializes it, and starts a "reader
+ thread" that will watch the output of the subprocess/stream and its
+ status. (If no vacant slot can be found, new_child returns a
+ failure indication to its caller, and the higher-level Emacs
+ primitive will then fail with EMFILE or EAGAIN.)
+
+ The reader thread started by new_child communicates with the main
+ (a.k.a. "Lisp") thread via two event objects and a status, all of
+ them recorded by the members of the child_process structure in
+ child_procs[]. The event objects serve as semaphores between the
+ reader thread and the 'select' emulation in sys_select, as follows:
+
+ . Initially, the reader thread is waiting for the char_consumed
+ event to become signaled by sys_select, which is an indication
+ for the reader thread to go ahead and try reading more stuff
+ from the subprocess/stream.
+
+ . The reader thread then attempts to read by calling a
+ blocking-read function. When the read call returns, either
+ successfully or with some failure indication, the reader thread
+ updates the status of the read accordingly, and signals the 2nd
+ event object, char_avail, on whose handle sys_select is
+ waiting. This tells sys_select that the file descriptor
+ allocated for the subprocess or the the stream is ready to be
+ read from.
+
+ When the subprocess exits or the network/serial stream is closed,
+ the reader thread sets the status accordingly and exits. It also
+ exits when the main thread sets the ststus to STATUS_READ_ERROR
+ and/or the char_avail and char_consumed event handles are NULL;
+ this is how delete_child, called by Emacs when a subprocess or a
+ stream is terminated, terminates the reader thread as part of
+ deleting the child_process object.
+
+ The sys_select function emulates the Posix 'pselect' function; it
+ is needed because the Windows 'select' function supports only
+ network sockets, while Emacs expects 'pselect' to work for any file
+ descriptor, including pipes and serial streams.
+
+ When sys_select is called, it uses the information in fd_info[]
+ array to convert the file descriptors which it was asked to watch
+ into Windows handles. In general, the handle to watch is the
+ handle of the char_avail event of the child_process structure that
+ corresponds to the file descriptor. In addition, for subprocesses,
+ sys_select watches one more handle: the handle for the subprocess,
+ so that it could emulate the SIGCHLD signal when the subprocess
+ exits.
+
+ If file descriptor zero (stdin) doesn't have its bit set in the
+ 'rfds' argument to sys_select, the function always watches for
+ keyboard interrupts, to be able to return when the user presses
+ C-g.
+
+ Having collected the handles to watch, sys_select calls
+ WaitForMultipleObjects to wait for any one of them to become
+ signaled. Since WaitForMultipleObjects can only watch up to 64
+ handles, Emacs on Windows is limited to maximum 32 child_process
+ objects (since a subprocess consumes 2 handles to be watched, see
+ above).
+
+ When any of the handles become signaled, sys_select does whatever
+ is appropriate for the corresponding child_process object:
+
+ . If it's a handle to the char_avail event, sys_select marks the
+ corresponding bit in 'rfds', and Emacs will then read from that
+ file descriptor.
+
+ . If it's a handle to the process, sys_select calls the SIGCHLD
+ handler, to inform Emacs of the fact that the subprocess
+ exited.
+
+ The waitpid emulation works very similar to sys_select, except that
+ it only watches handles of subprocesses, and doesn't synchronize
+ with the reader thread.
+
+ Because socket descriptors on Windows are handles, while Emacs
+ expects them to be file descriptors, all low-level I/O functions,
+ such as 'read' and 'write', and all socket operations, like
+ 'connect', 'recvfrom', 'accept', etc., are redirected to the
+ corresponding 'sys_*' functions, which must convert a file
+ descriptor to a handle using the fd_info[] array, and then invoke
+ the corresponding Windows API on the handle. Most of these
+ redirected 'sys_*' functions are implemented on w32.c.
+
+ When the file descriptor was produced by functions such as 'open',
+ the corresponding handle is obtained by calling _get_osfhandle. To
+ produce a file descriptor for a socket handle, which has no file
+ descriptor as far as Windows is concerned, the function
+ socket_to_fd opens the null device; the resulting file descriptor
+ will never be used directly in any I/O API, but serves as an index
+ into the fd_info[] array, where the socket handle is stored. The
+ SOCK_HANDLE macro retrieves the handle when given the file
+ descriptor.
+
+ The function sys_kill emulates the Posix 'kill' functionality to
+ terminate other processes. It does that by attaching to the
+ foreground window of the process and sending a Ctrl-C or Ctrl-BREAK
+ signal to the process; if that doesn't work, then it calls
+ TerminateProcess to forcibly terminate the process. Note that this
+ only terminates the immediate process whose PID was passed to
+ sys_kill; it doesn't terminate the child processes of that process.
+ This means, for example, that an Emacs subprocess run through a
+ shell might not be killed, because sys_kill will only terminate the
+ shell. (In practice, however, such problems are very rare.) */
+
/* Defined in <process.h> which conflicts with the local copy */
#define _P_NOWAIT 1
{
int rc;
- if (cp->fd >= 0 && fd_info[cp->fd].flags & FILE_LISTEN)
+ if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_CONNECT) != 0)
+ rc = _sys_wait_connect (cp->fd);
+ else if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_LISTEN) != 0)
rc = _sys_wait_accept (cp->fd);
else
rc = _sys_read_ahead (cp->fd);
return 1;
}
- if (rc == STATUS_READ_ERROR)
- return 1;
+ if (rc == STATUS_READ_ERROR || rc == STATUS_CONNECT_FAILED)
+ return 2;
/* If the read died, the child has died so let the thread die */
if (rc == STATUS_READ_FAILED)
sys_select (int nfds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds,
struct timespec *timeout, void *ignored)
{
- SELECT_TYPE orfds;
+ SELECT_TYPE orfds, owfds;
DWORD timeout_ms, start_time;
int i, nh, nc, nr;
DWORD active;
return 0;
}
- /* Otherwise, we only handle rfds, so fail otherwise. */
- if (rfds == NULL || wfds != NULL || efds != NULL)
+ /* Otherwise, we only handle rfds and wfds, so fail otherwise. */
+ if ((rfds == NULL && wfds == NULL) || efds != NULL)
{
errno = EINVAL;
return -1;
}
- orfds = *rfds;
- FD_ZERO (rfds);
+ if (rfds)
+ {
+ orfds = *rfds;
+ FD_ZERO (rfds);
+ }
+ else
+ FD_ZERO (&orfds);
+ if (wfds)
+ {
+ owfds = *wfds;
+ FD_ZERO (wfds);
+ }
+ else
+ FD_ZERO (&owfds);
nr = 0;
/* If interrupt_handle is available and valid, always wait on it, to
/* Build a list of pipe handles to wait on. */
for (i = 0; i < nfds; i++)
- if (FD_ISSET (i, &orfds))
+ if (FD_ISSET (i, &orfds) || FD_ISSET (i, &owfds))
{
if (i == 0)
{
/* Check for any emacs-generated input in the queue since
it won't be detected in the wait */
- if (detect_input_pending ())
+ if (rfds && detect_input_pending ())
{
FD_SET (i, rfds);
return 1;
{
/* Child process and socket/comm port input. */
cp = fd_info[i].cp;
+ if (FD_ISSET (i, &owfds)
+ && cp
+ && (fd_info[i].flags && FILE_CONNECT) == 0)
+ {
+ DebPrint (("sys_select: fd %d is in wfds, but FILE_CONNECT is reset!\n", i));
+ cp = NULL;
+ }
if (cp)
{
int current_status = cp->status;
{
/* Tell reader thread which file handle to use. */
cp->fd = i;
+ /* Zero out the error code. */
+ cp->errcode = 0;
/* Wake up the reader thread for this process */
cp->status = STATUS_READ_READY;
if (!SetEvent (cp->char_consumed))
if (cp->fd >= 0 && (fd_info[cp->fd].flags & FILE_AT_EOF) == 0)
fd_info[cp->fd].flags |= FILE_SEND_SIGCHLD;
- /* SIG_DFL for SIGCHLD is ignore */
+ /* SIG_DFL for SIGCHLD is ignored */
else if (sig_handlers[SIGCHLD] != SIG_DFL &&
sig_handlers[SIGCHLD] != SIG_IGN)
{
errno = EINTR;
return -1;
}
- else if (fdindex[active] == 0)
+ else if (rfds && fdindex[active] == 0)
{
/* Keyboard input available */
FD_SET (0, rfds);
}
else
{
- /* must be a socket or pipe - read ahead should have
- completed, either succeeding or failing. */
- FD_SET (fdindex[active], rfds);
+ /* Must be a socket or pipe - read ahead should have
+ completed, either succeeding or failing. If this handle
+ was waiting for an async 'connect', reset the connect
+ flag, so it could read from now on. */
+ if (wfds && (fd_info[fdindex[active]].flags & FILE_CONNECT) != 0)
+ {
+ cp = fd_info[fdindex[active]].cp;
+ if (cp)
+ {
+ /* Don't reset the FILE_CONNECT bit and don't
+ acknowledge the read if the status is
+ STATUS_CONNECT_FAILED or some other
+ failure. That's because the thread exits in those
+ cases, so it doesn't need the ACK, and we want to
+ keep the FILE_CONNECT bit as evidence that the
+ connect failed, to be checked in sys_read. */
+ if (cp->status == STATUS_READ_SUCCEEDED)
+ {
+ fd_info[cp->fd].flags &= ~FILE_CONNECT;
+ cp->status = STATUS_READ_ACKNOWLEDGED;
+ }
+ ResetEvent (cp->char_avail);
+ }
+ FD_SET (fdindex[active], wfds);
+ }
+ else if (rfds)
+ FD_SET (fdindex[active], rfds);
nr++;
}
if (notification_buffer_in_use)
{
DWORD info_size = notifications_size;
- Lisp_Object cs = intern ("utf-16le");
+ Lisp_Object cs = Qutf_16le;
Lisp_Object obj = w32_get_watch_object (notifications_desc);
/* notifications_size could be zero when the buffer of
enum scroll_bar_part *,
Lisp_Object *, Lisp_Object *,
Time *);
-static void x_check_fullscreen (struct frame *);
-
static void
w32_define_cursor (Window window, Cursor cursor)
{
sets the WAIT flag. */
if ((msg.msg.message == WM_WINDOWPOSCHANGED || msg.msg.wParam)
&& (f->want_fullscreen & FULLSCREEN_WAIT))
- w32fullscreen_hook (f);
- x_check_fullscreen (f);
+ {
+ /* Must set visibility right here since otherwise
+ w32fullscreen_hook returns immediately. */
+ SET_FRAME_VISIBLE (f, 1);
+ w32fullscreen_hook (f);
+ }
}
check_visibility = 1;
break;
case SIZE_MAXIMIZED:
{
bool iconified = FRAME_ICONIFIED_P (f);
+ Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
SET_FRAME_VISIBLE (f, 1);
SET_FRAME_ICONIFIED (f, false);
to update the frame titles
in case this is the second frame. */
record_asynch_buffer_change ();
- }
- if (EQ (get_frame_param (f, Qfullscreen), Qnil))
- set_frame_param (f, Qfullscreen, Qmaximized);
- else if (! EQ (get_frame_param (f, Qfullscreen), Qmaximized))
- set_frame_param (f, Qmaximized, Qmaximized);
+ /* Windows can send us a SIZE_MAXIMIZED message even
+ when fullscreen is fullboth. The following is a
+ simple hack to check that based on the fact that
+ only a maximized fullscreen frame should have both
+ top/left outside the screen. */
+ if (EQ (fullscreen, Qfullwidth) || EQ (fullscreen, Qfullheight)
+ || NILP (fullscreen))
+ {
+ int x, y;
+
+ x_real_positions (f, &x, &y);
+ if (x < 0 && y < 0)
+ store_frame_param (f, Qfullscreen, Qmaximized);
+ }
+ }
break;
}
if (EQ (get_frame_param (f, Qfullscreen), Qmaximized))
- set_frame_param (f, Qfullscreen, Qnil);
- else if (! EQ (get_frame_param (f, Qmaximized), Qnil))
- set_frame_param (f, Qmaximized, Qnil);
+ store_frame_param (f, Qfullscreen, Qnil);
break;
}
if (f)
{
+ Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+
dpyinfo->n_cbits = msg.msg.wParam;
/* The new display could have a different resolution, in
- which case we must reconsider what fullscreen
- means. */
- x_check_fullscreen (f);
+ which case we must reconsider what fullscreen means.
+ The following code is untested yet. */
+ if (!NILP (fullscreen))
+ {
+ x_set_fullscreen (f, fullscreen, fullscreen);
+ w32fullscreen_hook (f);
+ }
+
DebPrint (("display change: %d %d\n",
(short) LOWORD (msg.msg.lParam),
(short) HIWORD (msg.msg.lParam)));
unblock_input ();
}
-/* Calculate fullscreen size. Return in *TOP_POS and *LEFT_POS the
- wanted positions of the WM window (not Emacs window).
- Return in *WIDTH and *HEIGHT the wanted width and height of Emacs
- window (FRAME_X_WINDOW).
- */
-
-static void
-x_fullscreen_adjust (struct frame *f, int *width, int *height, int *top_pos, int *left_pos)
-{
- int newwidth = FRAME_COLS (f);
- int newheight = FRAME_LINES (f);
- Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f);
-
- *top_pos = f->top_pos;
- *left_pos = f->left_pos;
-
- if (f->want_fullscreen & FULLSCREEN_HEIGHT)
- {
- int ph;
-
- ph = x_display_pixel_height (dpyinfo);
- newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
- ph = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, newheight) - f->y_pixels_diff;
- newheight = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, ph);
- *top_pos = 0;
- }
-
- if (f->want_fullscreen & FULLSCREEN_WIDTH)
- {
- int pw;
-
- pw = x_display_pixel_width (dpyinfo);
- newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
- pw = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, newwidth) - f->x_pixels_diff;
- newwidth = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pw);
- *left_pos = 0;
- }
-
- *width = newwidth;
- *height = newheight;
-}
-
-/* Check if we need to resize the frame due to a fullscreen request.
- If so needed, resize the frame. */
-static void
-x_check_fullscreen (struct frame *f)
-{
- if (f->want_fullscreen & FULLSCREEN_BOTH)
- {
- int width, height, ign;
-
- x_real_positions (f, &f->left_pos, &f->top_pos);
-
- x_fullscreen_adjust (f, &width, &height, &ign, &ign);
-
- /* We do not need to move the window, it shall be taken care of
- when setting WM manager hints. */
- if (FRAME_COLS (f) != width || FRAME_LINES (f) != height)
- {
- change_frame_size (f, width, height, 0, 1, 0, 0);
- SET_FRAME_GARBAGED (f);
- cancel_mouse_face (f);
-
- /* Wait for the change of frame size to occur. */
- f->want_fullscreen |= FULLSCREEN_WAIT;
- }
- }
-}
-
static void
w32fullscreen_hook (struct frame *f)
{
}
else if (f->want_fullscreen == FULLSCREEN_BOTH)
{
+ int menu_bar_height = GetSystemMetrics (SM_CYMENU);
+
w32_fullscreen_rect (hwnd, f->want_fullscreen,
FRAME_NORMAL_PLACEMENT (f).rcNormalPosition, &rect);
SetWindowLong (hwnd, GWL_STYLE, dwStyle & ~WS_OVERLAPPEDWINDOW);
SetWindowPos (hwnd, HWND_TOP, rect.left, rect.top,
rect.right - rect.left, rect.bottom - rect.top,
SWP_NOOWNERZORDER | SWP_FRAMECHANGED);
+ change_frame_size
+ (f, FRAME_PIXEL_TO_TEXT_WIDTH (f, rect.right - rect.left),
+ FRAME_PIXEL_TO_TEXT_HEIGHT (f, (rect.bottom - rect.top
+ - menu_bar_height)),
+ 0, 1, 0, 1);
}
else
{
FRAME_NORMAL_PLACEMENT (f).rcNormalPosition, &rect);
SetWindowPos (hwnd, HWND_TOP, rect.left, rect.top,
rect.right - rect.left, rect.bottom - rect.top, 0);
+
+ if (f->want_fullscreen == FULLSCREEN_WIDTH)
+ {
+ int border_width = GetSystemMetrics (SM_CXFRAME);
+
+ change_frame_size
+ (f, (FRAME_PIXEL_TO_TEXT_WIDTH
+ (f, rect.right - rect.left - 2 * border_width)),
+ 0, 0, 1, 0, 1);
+ }
+ else
+ {
+ int border_height = GetSystemMetrics (SM_CYFRAME);
+ /* Won't work for wrapped menu bar. */
+ int menu_bar_height = GetSystemMetrics (SM_CYMENU);
+ int title_height = GetSystemMetrics (SM_CYCAPTION);
+
+ change_frame_size
+ (f, 0, (FRAME_PIXEL_TO_TEXT_HEIGHT
+ (f, rect.bottom - rect.top - 2 * border_height
+ - title_height - menu_bar_height)),
+ 0, 1, 0, 1);
+ }
}
f->want_fullscreen = FULLSCREEN_NONE;
unblock_input ();
+
+ if (f->want_fullscreen == FULLSCREEN_BOTH
+ || f->want_fullscreen == FULLSCREEN_WIDTH
+ || f->want_fullscreen == FULLSCREEN_HEIGHT)
+ do_pending_window_change (0);
+
}
else
f->want_fullscreen |= FULLSCREEN_WAIT;
int width, int height, bool pixelwise)
{
int pixelwidth, pixelheight;
+ Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
RECT rect;
block_input ();
if (w32_add_wrapped_menu_bar_lines)
{
/* When the menu bar wraps sending a SetWindowPos shrinks the
- height of the frame when the wrapped menu bar lines are not
+ height of the frame then the wrapped menu bar lines are not
accounted for (Bug#15174 and Bug#18720). Here we add these
extra lines to the frame height. */
MENUBARINFO info;
f->win_gravity = NorthWestGravity;
x_wm_set_size_hint (f, (long) 0, false);
- f->want_fullscreen = FULLSCREEN_NONE;
- w32fullscreen_hook (f);
-
rect.left = rect.top = 0;
rect.right = pixelwidth;
rect.bottom = pixelheight;
AdjustWindowRect (&rect, f->output_data.w32->dwStyle,
FRAME_EXTERNAL_MENU_BAR (f));
- my_set_window_pos (FRAME_W32_WINDOW (f),
- NULL,
- 0, 0,
- rect.right - rect.left,
- rect.bottom - rect.top,
- SWP_NOZORDER | SWP_NOMOVE | SWP_NOACTIVATE);
-
- /* If w32_enable_frame_resize_hack is non-nil, immediately apply the
- new pixel sizes to the frame and its subwindows.
-
- Jason Rumney earlier refused to call change_frame_size right here
- with the following argument:
-
- The following mirrors what is done in xterm.c. It appears to be for
- informing lisp of the new size immediately, while the actual resize
- will happen asynchronously. But on Windows, the menu bar
- automatically wraps when the frame is too narrow to contain it, and
- that causes any calculations made here to come out wrong. The end
- is some nasty buggy behavior, including the potential loss of the
- minibuffer.
-
- Disabling this code is either not sufficient to fix the problems
- completely, or it causes fresh problems, but at least it removes
- the most problematic symptom of the minibuffer becoming unusable.
-
- However, as the discussion about how to handle frame size
- parameters on Windows (Bug#1348, Bug#16028) shows, that cure seems
- worse than the disease. In particular, menu bar wrapping looks
- like a non-issue - maybe so because Windows eventually gets back to
- us with the correct client rectangle anyway. But we have to avoid
- calling change_frame_size with a delta of less than one canoncial
- character size when frame_resize_pixelwise is nil, as explained in
- the comment above. */
-
- if (w32_enable_frame_resize_hack)
+ if (!(f->after_make_frame)
+ && !(f->want_fullscreen & FULLSCREEN_WAIT)
+ && FRAME_VISIBLE_P (f))
+ {
+ RECT window_rect;
+ GetWindowRect (FRAME_W32_WINDOW (f), &window_rect);
+
+ if (EQ (fullscreen, Qmaximized)
+ || EQ (fullscreen, Qfullboth)
+ || EQ (fullscreen, Qfullwidth))
+ {
+ rect.left = window_rect.left;
+ rect.right = window_rect.right;
+ pixelwidth = 0;
+ }
+ if (EQ (fullscreen, Qmaximized)
+ || EQ (fullscreen, Qfullboth)
+ || EQ (fullscreen, Qfullheight))
+ {
+ rect.top = window_rect.top;
+ rect.bottom = window_rect.bottom;
+ pixelheight = 0;
+ }
+ }
+
+ if (pixelwidth > 0 || pixelheight > 0)
{
- change_frame_size (f, FRAME_PIXEL_TO_TEXT_WIDTH (f, pixelwidth),
- FRAME_PIXEL_TO_TEXT_HEIGHT (f, pixelheight),
+ my_set_window_pos (FRAME_W32_WINDOW (f), NULL,
+ 0, 0,
+ rect.right - rect.left,
+ rect.bottom - rect.top,
+ SWP_NOZORDER | SWP_NOMOVE | SWP_NOACTIVATE);
+
+ change_frame_size (f,
+ ((pixelwidth == 0)
+ ? 0 : FRAME_PIXEL_TO_TEXT_WIDTH (f, pixelwidth)),
+ ((pixelheight == 0)
+ ? 0 : FRAME_PIXEL_TO_TEXT_HEIGHT (f, pixelheight)),
0, 1, 0, 1);
SET_FRAME_GARBAGED (f);
w32_unicode_filenames = 0;
- /* FIXME: The following two variables will be (hopefully) removed
+ /* FIXME: The following variable will be (hopefully) removed
before Emacs 25.1 gets released. */
DEFVAR_BOOL ("w32-add-wrapped-menu-bar-lines",
API. */);
w32_add_wrapped_menu_bar_lines = 1;
- DEFVAR_BOOL ("w32-enable-frame-resize-hack",
- w32_enable_frame_resize_hack,
- doc: /* Non-nil means enable hack for frame resizing on Windows.
-A value of nil means to resize frames by sending a corresponding request
-to the Windows API and changing the pixel sizes of the frame and its
-windows after the latter calls back. If this is non-nil, Emacs changes
-the pixel sizes of the frame and its windows at the time it sends the
-resize request to the API. */);
- w32_enable_frame_resize_hack = 1;
-
/* Tell Emacs about this window system. */
Fprovide (Qw32, Qnil);
}
base_width = (wmshell->core.width - ew->core.width
+ (rounded_width - (char_width * cw)));
base_height = (wmshell->core.height - ew->core.height
- + (rounded_height - (char_height * ch)));
+ + (rounded_height - (char_height * ch)));
/* 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.
{
EmacsFrame ew = (EmacsFrame)widget;
struct frame *f = ew->emacs_frame.frame;
+ int width, height;
- /* Always process resize requests pixelwise. Frame maximizing
- should work even when frame_resize_pixelwise is nil. */
- if (true || frame_resize_pixelwise)
- {
- int width, height;
-
- pixel_to_text_size (ew, ew->core.width, ew->core.height, &width, &height);
- change_frame_size (f, width, height, 0, 1, 0, 1);
+ pixel_to_text_size (ew, ew->core.width, ew->core.height, &width, &height);
- update_wm_hints (ew);
- update_various_frame_slots (ew);
+ frame_size_history_add
+ (f, QEmacsFrameResize, width, height,
+ list2 (make_number (ew->core.width), make_number (ew->core.height)));
- cancel_mouse_face (f);
- }
- else
- {
- struct x_output *x = f->output_data.x;
- int columns, rows;
+ change_frame_size (f, width, height, 0, 1, 0, 1);
- pixel_to_char_size (ew, ew->core.width, ew->core.height, &columns, &rows);
- if (columns != FRAME_COLS (f)
- || rows != FRAME_LINES (f)
- || ew->core.width != FRAME_PIXEL_WIDTH (f)
- || ew->core.height + x->menubar_height != FRAME_PIXEL_HEIGHT (f))
- {
- change_frame_size (f, columns, rows, 0, 1, 0, 0);
- update_wm_hints (ew);
- update_various_frame_slots (ew);
+ update_wm_hints (ew);
+ update_various_frame_slots (ew);
- cancel_mouse_face (f);
- }
- }
+ cancel_mouse_face (f);
}
static XtGeometryResult
#ifdef MSDOS
#include "msdos.h"
#endif
-#ifdef HAVE_XWIDGETS
-#include "xwidget.h"
-#endif
static int displayed_window_lines (struct window *);
static int count_windows (struct window *);
if (NILP (Vrun_hooks)
|| !(f->can_x_set_window_size)
- || !(f->can_run_window_configuration_change_hook))
+ || !(f->after_make_frame))
return;
/* Use the right buffer. Matters when running the local hooks. */
/* Block input. */
block_input ();
-#ifdef HAVE_XWIDGETS
- xwidget_view_delete_all_in_window(w);
-#endif
window_resize_apply (p, horflag);
/* If this window is referred to by the dpyinfo's mouse
highlight, invalidate that slot to be safe (Bug#9904). */
if (NILP (tem))
{
- Fvertical_motion (make_number (- (ht / 2)), window);
+ Fvertical_motion (make_number (- (ht / 2)), window, Qnil);
startpos = PT;
startbyte = PT_BYTE;
}
SET_PT_BOTH (startpos, startbyte);
lose = n < 0 && PT == BEGV;
- Fvertical_motion (make_number (n), window);
+ Fvertical_motion (make_number (n), window, Qnil);
pos = PT;
pos_byte = PT_BYTE;
bolp = Fbolp ();
&& (whole || !EQ (Vscroll_preserve_screen_position, Qt)))
{
SET_PT_BOTH (pos, pos_byte);
- Fvertical_motion (original_pos, window);
+ Fvertical_motion (original_pos, window, Qnil);
}
/* If we scrolled forward, put point enough lines down
that it is outside the scroll margin. */
if (this_scroll_margin > 0)
{
SET_PT_BOTH (pos, pos_byte);
- Fvertical_motion (make_number (this_scroll_margin), window);
+ Fvertical_motion (make_number (this_scroll_margin), window, Qnil);
top_margin = PT;
}
else
else if (!NILP (Vscroll_preserve_screen_position))
{
SET_PT_BOTH (pos, pos_byte);
- Fvertical_motion (original_pos, window);
+ Fvertical_motion (original_pos, window, Qnil);
}
else
SET_PT (top_margin);
/* If we scrolled backward, put point near the end of the window
but not within the scroll margin. */
SET_PT_BOTH (pos, pos_byte);
- tem = Fvertical_motion (make_number (ht - this_scroll_margin), window);
+ tem = Fvertical_motion (make_number (ht - this_scroll_margin), window,
+ Qnil);
if (XFASTINT (tem) == ht - this_scroll_margin)
bottom_margin = PT;
else
if (!NILP (Vscroll_preserve_screen_position))
{
SET_PT_BOTH (pos, pos_byte);
- Fvertical_motion (original_pos, window);
+ Fvertical_motion (original_pos, window, Qnil);
}
else
- Fvertical_motion (make_number (-1), window);
+ Fvertical_motion (make_number (-1), window, Qnil);
}
}
}
if (start < BEGV || start > ZV)
{
int height = window_internal_height (w);
- Fvertical_motion (make_number (- (height / 2)), window);
+ Fvertical_motion (make_number (- (height / 2)), window, Qnil);
set_marker_both (w->start, w->contents, PT, PT_BYTE);
w->start_at_line_beg = !NILP (Fbolp ());
w->force_start = 1;
if (w->vscroll)
XSETINT (arg, XINT (arg) + 1);
- return Fvertical_motion (arg, window);
+ return Fvertical_motion (arg, window, Qnil);
}
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
-#ifdef HAVE_XWIDGETS
-#include "xwidget.h"
-#endif
#ifndef FRAME_X_OUTPUT
#define FRAME_X_OUTPUT(f) ((f)->output_data.x)
#endif
&& (IT)->current_x == (IT)->last_visible_x)
#else /* !HAVE_WINDOW_SYSTEM */
-#define IT_OVERFLOW_NEWLINE_INTO_FRINGE(it) 0
+#define IT_OVERFLOW_NEWLINE_INTO_FRINGE(it) false
#endif /* HAVE_WINDOW_SYSTEM */
/* Test if the display element loaded in IT, or the underlying buffer
&& (*BYTE_POS_ADDR (IT_BYTEPOS (*it)) == ' ' \
|| *BYTE_POS_ADDR (IT_BYTEPOS (*it)) == '\t')))) \
-/* Non-zero means print newline to stdout before next mini-buffer
- message. */
+/* True means print newline to stdout before next mini-buffer message. */
bool noninteractive_need_newline;
-/* Non-zero means print newline to message log before next message. */
+/* True means print newline to message log before next message. */
static bool message_log_need_newline;
static struct buffer *this_line_buffer;
-/* Nonzero if an overlay arrow has been displayed in this window. */
+/* True if an overlay arrow has been displayed in this window. */
static bool overlay_arrow_seen;
static Lisp_Object Vmessage_stack;
-/* Nonzero means multibyte characters were enabled when the echo area
+/* True means multibyte characters were enabled when the echo area
message was specified. */
static bool message_enable_multibyte;
int windows_or_buffers_changed;
-/* Nonzero after display_mode_line if %l was used and it displayed a
+/* True after display_mode_line if %l was used and it displayed a
line number. */
static bool line_number_displayed;
static Lisp_Object Vwith_echo_area_save_vector;
-/* Non-zero means display_echo_area should display the last echo area
+/* True means display_echo_area should display the last echo area
message again. Set by redisplay_preserve_echo_area. */
static bool display_last_displayed_message_p;
-/* Nonzero if echo area is being used by print; zero if being used by
+/* True if echo area is being used by print; false if being used by
message. */
static bool message_buf_print;
-/* Set to 1 in clear_message to make redisplay_internal aware
+/* Set to true in clear_message to make redisplay_internal aware
of an emptied echo area. */
static bool message_cleared_p;
static int last_height;
-/* Non-zero if there's a help-echo in the echo area. */
+/* True if there's a help-echo in the echo area. */
bool help_echo_showing_p;
move around the buffer, we can cause the bidi cache to be pushed or
popped, and therefore we need to restore the cache state when we
return to the original iterator. */
-#define SAVE_IT(ITCOPY,ITORIG,CACHE) \
+#define SAVE_IT(ITCOPY, ITORIG, CACHE) \
do { \
if (CACHE) \
- bidi_unshelve_cache (CACHE, 1); \
+ bidi_unshelve_cache (CACHE, true); \
ITCOPY = ITORIG; \
CACHE = bidi_shelve_cache (); \
- } while (0)
+ } while (false)
-#define RESTORE_IT(pITORIG,pITCOPY,CACHE) \
+#define RESTORE_IT(pITORIG, pITCOPY, CACHE) \
do { \
if (pITORIG != pITCOPY) \
*(pITORIG) = *(pITCOPY); \
- bidi_unshelve_cache (CACHE, 0); \
+ bidi_unshelve_cache (CACHE, false); \
CACHE = NULL; \
- } while (0)
+ } while (false)
/* Functions to mark elements as needing redisplay. */
enum { REDISPLAY_SOME = 2}; /* Arbitrary choice. */
#ifdef GLYPH_DEBUG
-/* Non-zero means print traces of redisplay if compiled with
+/* True means print traces of redisplay if compiled with
GLYPH_DEBUG defined. */
bool trace_redisplay_p;
#endif /* GLYPH_DEBUG */
#ifdef DEBUG_TRACE_MOVE
-/* Non-zero means trace with TRACE_MOVE to stderr. */
-int trace_move;
+/* True means trace with TRACE_MOVE to stderr. */
+static bool trace_move;
#define TRACE_MOVE(x) if (trace_move) fprintf x; else (void) 0
#else
#ifdef HAVE_WINDOW_SYSTEM
-/* Non-zero means an hourglass cursor is currently shown. */
+/* True means an hourglass cursor is currently shown. */
static bool hourglass_shown_p;
/* If non-null, an asynchronous timer that, when it expires, displays
/* Function prototypes. */
static void setup_for_ellipsis (struct it *, int);
-static void set_iterator_to_next (struct it *, int);
-static void mark_window_display_accurate_1 (struct window *, int);
-static int single_display_spec_string_p (Lisp_Object, Lisp_Object);
-static int display_prop_string_p (Lisp_Object, Lisp_Object);
-static int row_for_charpos_p (struct glyph_row *, ptrdiff_t);
-static int cursor_row_p (struct glyph_row *);
+static void set_iterator_to_next (struct it *, bool);
+static void mark_window_display_accurate_1 (struct window *, bool);
+static bool row_for_charpos_p (struct glyph_row *, ptrdiff_t);
+static bool cursor_row_p (struct glyph_row *);
static int redisplay_mode_lines (Lisp_Object, bool);
-static char *decode_mode_spec_coding (Lisp_Object, char *, int);
-
-static Lisp_Object get_it_property (struct it *it, Lisp_Object prop);
static void handle_line_prefix (struct it *);
-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 int text_outside_line_unchanged_p (struct window *,
- 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 *, ptrdiff_t);
-static void vmessage (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0);
-static void ensure_echo_area_buffers (void);
static void 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 (*) (ptrdiff_t, Lisp_Object),
- ptrdiff_t, Lisp_Object);
-static void clear_garbaged_frames (void);
-static int current_message_1 (ptrdiff_t, Lisp_Object);
-static int truncate_message_1 (ptrdiff_t, Lisp_Object);
+static bool current_message_1 (ptrdiff_t, Lisp_Object);
+static bool truncate_message_1 (ptrdiff_t, Lisp_Object);
static void set_message (Lisp_Object);
-static int set_message_1 (ptrdiff_t, Lisp_Object);
-static int display_echo_area (struct window *);
-static int display_echo_area_1 (ptrdiff_t, Lisp_Object);
-static int resize_mini_window_1 (ptrdiff_t, Lisp_Object);
+static bool set_message_1 (ptrdiff_t, Lisp_Object);
+static bool display_echo_area_1 (ptrdiff_t, Lisp_Object);
+static bool resize_mini_window_1 (ptrdiff_t, Lisp_Object);
static void unwind_redisplay (void);
-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 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, ptrdiff_t, ptrdiff_t, int, int);
-static int try_cursor_movement (Lisp_Object, struct text_pos, 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 void sync_frame_with_window_matrix_rows (struct window *);
static void redisplay_internal (void);
static bool echo_area_display (bool);
static void redisplay_windows (Lisp_Object);
static Lisp_Object redisplay_window_error (Lisp_Object);
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 *, 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 bool set_cursor_from_row (struct window *, struct glyph_row *,
+ struct glyph_matrix *, ptrdiff_t, ptrdiff_t,
+ int, int);
+static bool update_menu_bar (struct frame *, bool, bool);
+static bool try_window_reusing_current_matrix (struct window *);
static int try_window_id (struct window *);
-static int display_line (struct it *);
+static bool display_line (struct it *);
static int display_mode_lines (struct window *);
static int display_mode_line (struct window *, enum face_id, Lisp_Object);
-static int display_mode_element (struct it *, int, int, int, Lisp_Object, Lisp_Object, int);
-static int store_mode_line_string (const char *, Lisp_Object, int, int, int, Lisp_Object);
+static int display_mode_element (struct it *, int, int, int, Lisp_Object,
+ Lisp_Object, bool);
+static int store_mode_line_string (const char *, Lisp_Object, bool, int, int,
+ Lisp_Object);
static const char *decode_mode_spec (struct window *, int, int, Lisp_Object *);
static void display_menu_bar (struct window *);
static ptrdiff_t display_count_lines (ptrdiff_t, ptrdiff_t, ptrdiff_t,
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 *, ptrdiff_t);
-static int get_overlay_strings_1 (struct it *, ptrdiff_t, int);
+static bool get_overlay_strings (struct it *, ptrdiff_t);
+static bool get_overlay_strings_1 (struct it *, ptrdiff_t, bool);
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 void back_to_previous_visible_line_start (struct it *);
-static void reseat_at_next_visible_line_start (struct it *, int);
-static int next_element_from_ellipsis (struct it *);
-static int next_element_from_display_vector (struct it *);
-static int next_element_from_string (struct it *);
-static int next_element_from_c_string (struct it *);
-static int next_element_from_buffer (struct it *);
-static int next_element_from_composition (struct it *);
-static int next_element_from_image (struct it *);
-#ifdef HAVE_XWIDGETS
-static int next_element_from_xwidget(struct it *);
-#endif
-static int next_element_from_stretch (struct it *);
+static void reseat (struct it *, struct text_pos, bool);
+static void reseat_1 (struct it *, struct text_pos, bool);
+static bool next_element_from_display_vector (struct it *);
+static bool next_element_from_string (struct it *);
+static bool next_element_from_c_string (struct it *);
+static bool next_element_from_buffer (struct it *);
+static bool next_element_from_composition (struct it *);
+static bool next_element_from_image (struct it *);
+static bool next_element_from_stretch (struct it *);
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, ptrdiff_t, ptrdiff_t, int, int);
-static int get_next_display_element (struct it *);
+static bool get_next_display_element (struct it *);
static enum move_it_result
move_it_in_display_line_to (struct it *, ptrdiff_t, int,
enum move_operation_enum);
static void get_visually_first_element (struct it *);
-static void init_to_row_start (struct it *, struct window *,
- struct glyph_row *);
-static int init_to_row_end (struct it *, struct window *,
- struct glyph_row *);
-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, ptrdiff_t);
-static struct text_pos string_pos (ptrdiff_t, Lisp_Object);
-static struct text_pos c_string_pos (ptrdiff_t, const char *, bool);
-static ptrdiff_t number_of_chars (const char *, bool);
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 int face_before_or_after_it_pos (struct it *, bool);
static ptrdiff_t next_overlay_change (ptrdiff_t);
static int handle_display_spec (struct it *, Lisp_Object, Lisp_Object,
- Lisp_Object, struct text_pos *, ptrdiff_t, int);
+ Lisp_Object, struct text_pos *, ptrdiff_t, bool);
static int handle_single_display_spec (struct it *, Lisp_Object,
Lisp_Object, Lisp_Object,
- struct text_pos *, ptrdiff_t, int, int);
+ struct text_pos *, ptrdiff_t, int, bool);
static int underlying_face_id (struct it *);
-static int in_ellipses_for_invisible_text_p (struct display_pos *,
- struct window *);
-#define face_before_it_pos(IT) face_before_or_after_it_pos ((IT), 1)
-#define face_after_it_pos(IT) face_before_or_after_it_pos ((IT), 0)
+#define face_before_it_pos(IT) face_before_or_after_it_pos (IT, true)
+#define face_after_it_pos(IT) face_before_or_after_it_pos (IT, false)
#ifdef HAVE_WINDOW_SYSTEM
-static void x_consider_frame_title (Lisp_Object);
-static void update_tool_bar (struct frame *, int);
-static int redisplay_tool_bar (struct frame *);
+static void update_tool_bar (struct frame *, bool);
static void x_draw_bottom_divider (struct window *w);
static void notice_overwritten_cursor (struct window *,
enum glyph_row_area,
return window_hscroll;
}
-/* Return 1 if position CHARPOS is visible in window W.
+/* Return true 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 *RTOP and *RBOT to pixel height of an invisible area of glyph at POS.
Set *ROWH and *VPOS to row's visible height and VPOS (row number). */
-int
+bool
pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
int *rtop, int *rbot, int *rowh, int *vpos)
{
struct it it;
void *itdata = bidi_shelve_cache ();
struct text_pos top;
- int visible_p = 0;
+ bool visible_p = false;
struct buffer *old_buffer = NULL;
bool r2l = false;
if (top_y < window_top_y)
visible_p = bottom_y > window_top_y;
else if (top_y < it.last_visible_y)
- visible_p = 1;
+ visible_p = true;
if (bottom_y >= it.last_visible_y
&& it.bidi_p && it.bidi_it.scan_dir == -1
&& IT_CHARPOS (it) < charpos)
move_it_to (&it, charpos, -1, bottom_y + ten_more_lines, -1,
MOVE_TO_POS | MOVE_TO_Y);
if (it.current_y > top_y)
- visible_p = 0;
+ visible_p = false;
}
RESTORE_IT (&it, &save_it, save_it_data);
get_next_display_element (&it2);
PRODUCE_GLYPHS (&it2);
it2_prev = it2;
- set_iterator_to_next (&it2, 1);
+ set_iterator_to_next (&it2, true);
} while (it2.method == GET_FROM_DISPLAY_VECTOR
&& IT_CHARPOS (it2) < charpos);
}
Lisp_Object spec = Fget_char_property (cpos, Qdisplay, Qnil);
Lisp_Object string = string_from_display_spec (spec);
struct text_pos tpos;
- int replacing_spec_p;
bool newline_in_string
= (STRINGP (string)
&& memchr (SDATA (string), '\n', SBYTES (string)));
SET_TEXT_POS (tpos, charpos, CHAR_TO_BYTE (charpos));
- replacing_spec_p
+ bool replacing_spec_p
= (!NILP (spec)
&& handle_display_spec (NULL, spec, Qnil, Qnil, &tpos,
charpos, FRAME_WINDOW_P (it.f)));
Lisp_Object startpos, endpos;
EMACS_INT start, end;
struct it it3;
- int it3_moved;
/* Find the first and the last buffer positions
covered by the display string. */
begins. */
start_display (&it3, w, top);
move_it_to (&it3, -1, 0, top_y, -1, MOVE_TO_X | MOVE_TO_Y);
- /* If it3_moved stays zero after the 'while' loop
+ /* If it3_moved stays false after the 'while' loop
below, that means we already were at a newline
before the loop (e.g., the display string begins
with a newline), so we don't need to (and cannot)
PRODUCE_GLYPHS will not produce anything for a
newline, and thus it3.glyph_row stays at its
stale content it got at top of the window. */
- it3_moved = 0;
+ bool it3_moved = false;
/* Finally, advance the iterator until we hit the
first display element whose character position is
CHARPOS, or until the first newline from the
if (IT_CHARPOS (it3) == charpos
|| ITERATOR_AT_END_OF_LINE_P (&it3))
break;
- it3_moved = 1;
- set_iterator_to_next (&it3, 0);
+ it3_moved = true;
+ set_iterator_to_next (&it3, false);
}
top_x = it3.current_x - it3.pixel_width;
/* Normally, we would exit the above loop because we
r2l = true;
}
else
- bidi_unshelve_cache (it2data, 1);
+ bidi_unshelve_cache (it2data, true);
}
- bidi_unshelve_cache (itdata, 0);
+ bidi_unshelve_cache (itdata, false);
if (old_buffer)
set_buffer_internal_1 (old_buffer);
*x = window_box_width (w, TEXT_AREA) - *x - 1;
}
-#if 0
+#if false
/* Debugging code. */
if (visible_p)
fprintf (stderr, "+pv pt=%d vs=%d --> x=%d y=%d rt=%d rb=%d rh=%d vp=%d\n",
/* Value is a text position, i.e. character and byte position, for
- character position CHARPOS in C string S. MULTIBYTE_P non-zero
+ character position CHARPOS in C string S. MULTIBYTE_P
means recognize multibyte characters. */
static struct text_pos
/* Value is the number of characters in C string S. MULTIBYTE_P
- non-zero means recognize multibyte characters. */
+ means recognize multibyte characters. */
static ptrdiff_t
number_of_chars (const char *s, bool multibyte_p)
/* Given a pixel position (PIX_X, PIX_Y) on frame F, return glyph
co-ordinates in (*X, *Y). Set *BOUNDS to the rectangle that the
- glyph at X, Y occupies, if BOUNDS != 0. If NOCLIP is non-zero, do
+ glyph at X, Y occupies, if BOUNDS != 0. If NOCLIP, do
not force the value into range. */
void
-pixel_to_glyph_coords (struct frame *f, register int pix_x, register int pix_y,
- int *x, int *y, NativeRectangle *bounds, int noclip)
+pixel_to_glyph_coords (struct frame *f, int pix_x, int pix_y, int *x, int *y,
+ NativeRectangle *bounds, bool noclip)
{
#ifdef HAVE_WINDOW_SYSTEM
goto virtual_glyph;
}
else if (!f->glyphs_initialized_p
- || (window = window_from_coordinates (f, gx, gy, &part, 0),
+ || (window = window_from_coordinates (f, gx, gy, &part, false),
NILP (window)))
{
width = FRAME_SMALLEST_CHAR_WIDTH (f);
STORE_NATIVE_RECT (*rect, gx, gy, width, height);
/* Visible feedback for debugging. */
-#if 0
-#if HAVE_X_WINDOWS
+#if false && defined HAVE_X_WINDOWS
XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
f->output_data.x->normal_gc,
gx, gy, width, height);
#endif
-#endif
}
Debugging
***********************************************************************/
-#if 0
-
/* Define CHECK_IT to perform sanity checks on iterators.
This is for debugging. It is too slow to do unconditionally. */
static void
-check_it (struct it *it)
+CHECK_IT (struct it *it)
{
+#if false
if (it->method == GET_FROM_STRING)
{
eassert (STRINGP (it->string));
eassert (it->current.dpvec_index >= 0);
else
eassert (it->current.dpvec_index < 0);
+#endif
}
-#define CHECK_IT(IT) check_it ((IT))
-
-#else /* not 0 */
-
-#define CHECK_IT(IT) (void) 0
-
-#endif /* not 0 */
-
-
-#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. */
static void
-check_window_end (struct window *w)
+CHECK_WINDOW_END (struct window *w)
{
+#if defined GLYPH_DEBUG && defined ENABLE_CHECKING
if (!MINI_WINDOW_P (w) && w->window_end_valid)
{
struct glyph_row *row;
|| MATRIX_ROW_DISPLAYS_TEXT_P (row)
|| MATRIX_ROW_VPOS (row, w->current_matrix) == 0));
}
+#endif
}
-#define CHECK_WINDOW_END(W) check_window_end ((W))
-
-#else
-
-#define CHECK_WINDOW_END(W) (void) 0
-
-#endif /* GLYPH_DEBUG and ENABLE_CHECKING */
-
/***********************************************************************
Iterator initialization
***********************************************************************/
it->paragraph_embedding = R2L;
else
it->paragraph_embedding = NEUTRAL_DIR;
- bidi_unshelve_cache (NULL, 0);
+ bidi_unshelve_cache (NULL, false);
bidi_init_it (charpos, IT_BYTEPOS (*it), FRAME_WINDOW_P (it->f),
&it->bidi_it);
}
/* Compute faces etc. */
- reseat (it, it->current.pos, 1);
+ reseat (it, it->current.pos, true);
}
CHECK_IT (it);
start_display (struct it *it, struct window *w, struct text_pos pos)
{
struct glyph_row *row;
- int first_vpos = WINDOW_WANTS_HEADER_LINE_P (w) ? 1 : 0;
+ bool first_vpos = WINDOW_WANTS_HEADER_LINE_P (w);
row = w->desired_matrix->rows + first_vpos;
init_iterator (it, w, CHARPOS (pos), BYTEPOS (pos), row, DEFAULT_FACE_ID);
position is in a string or image. */
if (it->method == GET_FROM_BUFFER && it->line_wrap != TRUNCATE)
{
- int start_at_line_beg_p;
int first_y = it->current_y;
/* If window start is not at a line start, skip forward to POS to
get the correct continuation lines width. */
- start_at_line_beg_p = (CHARPOS (pos) == BEGV
- || FETCH_BYTE (BYTEPOS (pos) - 1) == '\n');
+ bool start_at_line_beg_p = (CHARPOS (pos) == BEGV
+ || FETCH_BYTE (BYTEPOS (pos) - 1) == '\n');
if (!start_at_line_beg_p)
{
int new_x;
(If we do go to the next line, C-e will not DTRT.) */
&& it->c != '\n')
{
- set_iterator_to_next (it, 1);
+ set_iterator_to_next (it, true);
move_it_in_display_line_to (it, -1, -1, 0);
}
}
-/* Return 1 if POS is a position in ellipses displayed for invisible
+/* Return true if POS is a position in ellipses displayed for invisible
text. W is the window we display, for text property lookup. */
-static int
+static bool
in_ellipses_for_invisible_text_p (struct display_pos *pos, struct window *w)
{
Lisp_Object prop, window;
- int ellipses_p = 0;
+ bool ellipses_p = false;
ptrdiff_t charpos = CHARPOS (pos->pos);
/* If POS specifies a position in a display vector, this might
&& (XSETWINDOW (window, w),
prop = Fget_char_property (make_number (charpos),
Qinvisible, window),
- !TEXT_PROP_MEANS_INVISIBLE (prop)))
+ TEXT_PROP_MEANS_INVISIBLE (prop) == 0))
{
prop = Fget_char_property (make_number (charpos - 1), Qinvisible,
window);
/* Initialize IT for stepping through current_buffer in window W,
starting at position POS that includes overlay string and display
vector/ control character translation position information. Value
- is zero if there are overlay strings with newlines at POS. */
+ is false if there are overlay strings with newlines at POS. */
-static int
+static bool
init_from_display_pos (struct it *it, struct window *w, struct display_pos *pos)
{
ptrdiff_t charpos = CHARPOS (pos->pos), bytepos = BYTEPOS (pos->pos);
- int i, overlay_strings_with_newlines = 0;
+ int i;
+ bool overlay_strings_with_newlines = false;
/* If POS specifies a position in a display vector, this might
be for an ellipsis displayed for invisible text. We won't
if (s < e)
{
- overlay_strings_with_newlines = 1;
+ overlay_strings_with_newlines = true;
break;
}
}
/* Initialize IT for stepping through current_buffer in window W
starting in the line following ROW, i.e. starting at ROW->end.
- Value is zero if there are overlay strings with newlines at ROW's
+ Value is false if there are overlay strings with newlines at ROW's
end position. */
-static int
+static bool
init_to_row_end (struct it *it, struct window *w, struct glyph_row *row)
{
- int success = 0;
+ bool success = false;
if (init_from_display_pos (it, w, &row->end))
{
it->continuation_lines_width
= row->continuation_lines_width + row->pixel_width;
CHECK_IT (it);
- success = 1;
+ success = true;
}
return success;
handle_stop (struct it *it)
{
enum prop_handled handled;
- int handle_overlay_change_p;
+ bool handle_overlay_change_p;
struct props *p;
it->dpvec = NULL;
it->current.dpvec_index = -1;
handle_overlay_change_p = !it->ignore_overlay_strings_at_pos_p;
- it->ignore_overlay_strings_at_pos_p = 0;
- it->ellipsis_p = 0;
+ it->ellipsis_p = false;
/* Use face of preceding text for ellipsis (if invisible) */
if (it->selective_display_ellipsis_p)
expected by the rest of the code that processes
overlay strings. */
|| (it->current.overlay_string_index < 0
- ? !get_overlay_strings_1 (it, 0, 0)
- : 0))
+ && !get_overlay_strings_1 (it, 0, false)))
{
if (it->ellipsis_p)
setup_for_ellipsis (it, 0);
pop_it (it);
else
{
- it->ignore_overlay_strings_at_pos_p = true;
- it->string_from_display_prop_p = 0;
- it->from_disp_prop_p = 0;
- handle_overlay_change_p = 0;
+ it->string_from_display_prop_p = false;
+ it->from_disp_prop_p = false;
+ handle_overlay_change_p = false;
}
handled = HANDLED_RECOMPUTE_PROPS;
break;
}
else if (handled == HANDLED_OVERLAY_STRING_CONSUMED)
- handle_overlay_change_p = 0;
+ handle_overlay_change_p = false;
}
if (handled != HANDLED_RECOMPUTE_PROPS)
/* Don't check for overlay strings below when set to deliver
characters from a display vector. */
if (it->method == GET_FROM_DISPLAY_VECTOR)
- handle_overlay_change_p = 0;
+ handle_overlay_change_p = false;
/* Handle overlay changes.
This sets HANDLED to HANDLED_RECOMPUTE_PROPS
/* Get the interval containing IT's position. Value is a null
interval if there isn't such an interval. */
position = make_number (charpos);
- iv = validate_interval_range (object, &position, &position, 0);
+ iv = validate_interval_range (object, &position, &position, false);
if (iv)
{
Lisp_Object values_here[LAST_PROP_IDX];
USE_SAFE_ALLOCA;
/* Get all overlays at the given position. */
- GET_OVERLAYS_AT (pos, overlays, noverlays, &endpos, 1);
+ GET_OVERLAYS_AT (pos, overlays, noverlays, &endpos, true);
/* If any of these overlays ends before endpos,
use its ending point instead. */
with `display' property whose value is a string, or a `display'
text property whose value is a string. STRING is data about the
string to iterate; if STRING->lstring is nil, we are iterating a
- buffer. FRAME_WINDOW_P is non-zero when we are displaying a window
+ buffer. FRAME_WINDOW_P is true when we are displaying a window
on a GUI frame. DISP_PROP is set to zero if we searched
MAX_DISP_SCAN characters forward without finding any display
strings, non-zero otherwise. It is set to 2 if the display string
compute_display_string_pos (struct text_pos *position,
struct bidi_string_data *string,
struct window *w,
- int frame_window_p, int *disp_prop)
+ bool frame_window_p, int *disp_prop)
{
/* OBJECT = nil means current buffer. */
Lisp_Object object, object1;
Lisp_Object pos, spec, limpos;
- int string_p = (string && (STRINGP (string->lstring) || string->s));
+ bool string_p = string && (STRINGP (string->lstring) || string->s);
ptrdiff_t eob = string_p ? string->schars : ZV;
ptrdiff_t begb = string_p ? 0 : BEGV;
ptrdiff_t bufpos, charpos = CHARPOS (*position);
/* Compute the face one character before or after the current position
- of IT, in the visual order. BEFORE_P non-zero means get the face
+ of IT, in the visual order. BEFORE_P means get the face
in front (to the left in L2R paragraphs, to the right in R2L
paragraphs) of IT's screen position. Value is the ID of the face. */
static int
-face_before_or_after_it_pos (struct it *it, int before_p)
+face_before_or_after_it_pos (struct it *it, bool before_p)
{
int face_id, limit;
ptrdiff_t next_check_charpos;
handle_invisible_prop (struct it *it)
{
enum prop_handled handled = HANDLED_NORMALLY;
- int invis_p;
+ int invis;
Lisp_Object prop;
if (STRINGP (it->string))
property. */
charpos = make_number (IT_STRING_CHARPOS (*it));
prop = Fget_text_property (charpos, Qinvisible, it->string);
- invis_p = TEXT_PROP_MEANS_INVISIBLE (prop);
+ invis = TEXT_PROP_MEANS_INVISIBLE (prop);
- if (invis_p && IT_STRING_CHARPOS (*it) < it->end_charpos)
+ if (invis != 0 && IT_STRING_CHARPOS (*it) < it->end_charpos)
{
/* Record whether we have to display an ellipsis for the
invisible text. */
- int display_ellipsis_p = (invis_p == 2);
+ bool display_ellipsis_p = (invis == 2);
ptrdiff_t len, endpos;
handled = HANDLED_RECOMPUTE_PROPS;
{
endpos = XFASTINT (end_charpos);
prop = Fget_text_property (end_charpos, Qinvisible, it->string);
- invis_p = TEXT_PROP_MEANS_INVISIBLE (prop);
- if (invis_p == 2)
+ invis = TEXT_PROP_MEANS_INVISIBLE (prop);
+ if (invis == 2)
display_ellipsis_p = true;
}
}
- while (invis_p && endpos < len);
+ while (invis != 0 && endpos < len);
if (display_ellipsis_p)
it->ellipsis_p = true;
if (it->bidi_it.first_elt
&& it->bidi_it.charpos < SCHARS (it->string))
bidi_paragraph_init (it->paragraph_embedding,
- &it->bidi_it, 1);
+ &it->bidi_it, true);
/* Bidi-iterate out of the invisible text. */
do
{
pos = make_number (tem);
prop = get_char_property_and_overlay (pos, Qinvisible, it->window,
&overlay);
- invis_p = TEXT_PROP_MEANS_INVISIBLE (prop);
+ invis = TEXT_PROP_MEANS_INVISIBLE (prop);
/* If we are on invisible text, skip over it. */
- if (invis_p && start_charpos < it->end_charpos)
+ if (invis != 0 && start_charpos < it->end_charpos)
{
/* Record whether we have to display an ellipsis for the
invisible text. */
- int display_ellipsis_p = invis_p == 2;
+ bool display_ellipsis_p = invis == 2;
handled = HANDLED_RECOMPUTE_PROPS;
text in the first place. If everything to the end of
the buffer was skipped, end the loop. */
if (newpos == tem || newpos >= ZV)
- invis_p = 0;
+ invis = 0;
else
{
/* We skipped some characters but not necessarily
all there are. Check if we ended up on visible
text. Fget_char_property returns the property of
the char before the given position, i.e. if we
- get invis_p = 0, this means that the char at
+ get invis = 0, this means that the char at
newpos is visible. */
pos = make_number (newpos);
prop = Fget_char_property (pos, Qinvisible, it->window);
- invis_p = TEXT_PROP_MEANS_INVISIBLE (prop);
+ invis = TEXT_PROP_MEANS_INVISIBLE (prop);
}
/* If we ended up on invisible text, proceed to
skip starting with next_stop. */
- if (invis_p)
+ if (invis != 0)
tem = next_stop;
/* If there are adjacent invisible texts, don't lose the
second one's ellipsis. */
- if (invis_p == 2)
+ if (invis == 2)
display_ellipsis_p = true;
}
- while (invis_p);
+ while (invis != 0);
/* The position newpos is now either ZV or on visible text. */
if (it->bidi_p)
{
ptrdiff_t bpos = CHAR_TO_BYTE (newpos);
- int on_newline
+ bool on_newline
= bpos == ZV_BYTE || FETCH_BYTE (bpos) == '\n';
- int after_newline
+ bool after_newline
= newpos <= BEGV || FETCH_BYTE (bpos - 1) == '\n';
/* If the invisible text ends on a newline or on a
bidi_dir_t pdir = it->bidi_it.paragraph_dir;
SET_TEXT_POS (tpos, newpos, bpos);
- reseat_1 (it, tpos, 0);
+ reseat_1 (it, tpos, false);
/* If we reseat on a newline/ZV, we need to prep the
bidi iterator for advancing to the next character
after the newline/EOB, keeping the current paragraph
prepending/appending glyphs to a glyph row). */
if (on_newline)
{
- it->bidi_it.first_elt = 0;
+ it->bidi_it.first_elt = false;
it->bidi_it.paragraph_dir = pdir;
it->bidi_it.ch = (bpos == ZV_BYTE) ? -1 : '\n';
it->bidi_it.nchars = 1;
text at the beginning, which resets the
FIRST_ELT flag. */
bidi_paragraph_init (it->paragraph_embedding,
- &it->bidi_it, 1);
+ &it->bidi_it, true);
}
do
{
IT_BYTEPOS (*it) = CHAR_TO_BYTE (newpos);
}
+ if (display_ellipsis_p)
+ {
+ /* Make sure that the glyphs of the ellipsis will get
+ correct `charpos' values. If we would not update
+ it->position here, the glyphs would belong to the
+ last visible character _before_ the invisible
+ text, which confuses `set_cursor_from_row'.
+
+ We use the last invisible position instead of the
+ first because this way the cursor is always drawn on
+ the first "." of the ellipsis, whenever PT is inside
+ the invisible text. Otherwise the cursor would be
+ placed _after_ the ellipsis when the point is after the
+ first invisible character. */
+ if (!STRINGP (it->object))
+ {
+ it->position.charpos = newpos - 1;
+ it->position.bytepos = CHAR_TO_BYTE (it->position.charpos);
+ }
+ }
+
/* If there are before-strings at the start of invisible
text, and the text is invisible because of a text
property, arrange to show before-strings because 20.x did
ended. So we play it safe here and force the
iterator to check for potential stop positions
immediately after the invisible text. Note that
- if get_overlay_strings returns non-zero, it
+ if get_overlay_strings returns true, it
normally also pushed the iterator stack, so we
need to update the stop position in the slot
below the current one. */
}
else if (display_ellipsis_p)
{
- /* Make sure that the glyphs of the ellipsis will get
- correct `charpos' values. If we would not update
- it->position here, the glyphs would belong to the
- last visible character _before_ the invisible
- text, which confuses `set_cursor_from_row'.
-
- We use the last invisible position instead of the
- first because this way the cursor is always drawn on
- the first "." of the ellipsis, whenever PT is inside
- the invisible text. Otherwise the cursor would be
- placed _after_ the ellipsis when the point is after the
- first invisible character. */
- if (!STRINGP (it->object))
- {
- it->position.charpos = newpos - 1;
- it->position.bytepos = CHAR_TO_BYTE (it->position.charpos);
- }
it->ellipsis_p = true;
/* Let the ellipsis display before
considering any properties of the following char.
if (it->saved_face_id < 0 || it->saved_face_id != it->face_id)
it->saved_face_id = it->face_id = DEFAULT_FACE_ID;
+ /* If the ellipsis represents buffer text, it means we advanced in
+ the buffer, so we should no longer ignore overlay strings. */
+ if (it->method == GET_FROM_BUFFER)
+ it->ignore_overlay_strings_at_pos_p = false;
+
it->method = GET_FROM_DISPLAY_VECTOR;
it->ellipsis_p = true;
}
struct text_pos *position;
ptrdiff_t bufpos;
/* Nonzero if some property replaces the display of the text itself. */
- int display_replaced_p = 0;
+ int display_replaced = 0;
if (STRINGP (it->string))
{
if (!STRINGP (it->string))
object = it->w->contents;
- display_replaced_p = handle_display_spec (it, propval, object, overlay,
- position, bufpos,
- FRAME_WINDOW_P (it->f));
-
- return display_replaced_p ? HANDLED_RETURN : HANDLED_NORMALLY;
+ display_replaced = handle_display_spec (it, propval, object, overlay,
+ position, bufpos,
+ FRAME_WINDOW_P (it->f));
+ return display_replaced != 0 ? HANDLED_RETURN : HANDLED_NORMALLY;
}
/* Subroutine of handle_display_prop. Returns non-zero if the display
compute_display_string_pos, which see.
See handle_single_display_spec for documentation of arguments.
- frame_window_p is non-zero if the window being redisplayed is on a
+ FRAME_WINDOW_P is true if the window being redisplayed is on a
GUI frame; this argument is used only if IT is NULL, see below.
IT can be NULL, if this is called by the bidi reordering code
static int
handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
Lisp_Object overlay, struct text_pos *position,
- ptrdiff_t bufpos, int frame_window_p)
+ ptrdiff_t bufpos, bool frame_window_p)
{
- int replacing_p = 0;
- int rv;
+ int replacing = 0;
if (CONSP (spec)
/* Simple specifications. */
&& !EQ (XCAR (spec), Qimage)
-#ifdef HAVE_XWIDGETS
- && !EQ (XCAR (spec), Qxwidget)
-#endif
&& !EQ (XCAR (spec), Qspace)
&& !EQ (XCAR (spec), Qwhen)
&& !EQ (XCAR (spec), Qslice)
{
for (; CONSP (spec); spec = XCDR (spec))
{
- if ((rv = handle_single_display_spec (it, XCAR (spec), object,
- overlay, position, bufpos,
- replacing_p, frame_window_p)))
+ int rv = handle_single_display_spec (it, XCAR (spec), object,
+ overlay, position, bufpos,
+ replacing, frame_window_p);
+ if (rv != 0)
{
- replacing_p = rv;
+ replacing = rv;
/* If some text in a string is replaced, `position' no
longer points to the position of `object'. */
if (!it || STRINGP (object))
{
ptrdiff_t i;
for (i = 0; i < ASIZE (spec); ++i)
- if ((rv = handle_single_display_spec (it, AREF (spec, i), object,
- overlay, position, bufpos,
- replacing_p, frame_window_p)))
- {
- replacing_p = rv;
- /* If some text in a string is replaced, `position' no
- longer points to the position of `object'. */
- if (!it || STRINGP (object))
- break;
- }
+ {
+ int rv = handle_single_display_spec (it, AREF (spec, i), object,
+ overlay, position, bufpos,
+ replacing, frame_window_p);
+ if (rv != 0)
+ {
+ replacing = rv;
+ /* If some text in a string is replaced, `position' no
+ longer points to the position of `object'. */
+ if (!it || STRINGP (object))
+ break;
+ }
+ }
}
else
- {
- if ((rv = handle_single_display_spec (it, spec, object, overlay,
- position, bufpos, 0,
- frame_window_p)))
- replacing_p = rv;
- }
-
- return replacing_p;
+ replacing = handle_single_display_spec (it, spec, object, overlay, position,
+ bufpos, 0, frame_window_p);
+ return replacing;
}
/* Value is the position of the end of the `display' property starting
is the object in which the `display' property was found. *POSITION
is the position in OBJECT at which the `display' property was found.
BUFPOS is the buffer position of OBJECT (different from POSITION if
- OBJECT is not a buffer). DISPLAY_REPLACED_P non-zero means that we
+ OBJECT is not a buffer). DISPLAY_REPLACED non-zero means that we
previously saw a display specification which already replaced text
display with something else, for example an image; we ignore such
properties after the first one has been processed.
property ends.
If IT is NULL, only examine the property specification in SPEC, but
- don't set up IT. In that case, FRAME_WINDOW_P non-zero means SPEC
+ don't set up IT. In that case, FRAME_WINDOW_P means SPEC
is intended to be displayed in a window on a GUI frame.
Value is non-zero if something was found which replaces the display
static int
handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
Lisp_Object overlay, struct text_pos *position,
- ptrdiff_t bufpos, int display_replaced_p,
- int frame_window_p)
+ ptrdiff_t bufpos, int display_replaced,
+ bool frame_window_p)
{
Lisp_Object form;
Lisp_Object location, value;
struct text_pos start_pos = *position;
- int valid_p;
/* If SPEC is a list of the form `(when FORM . VALUE)', evaluate FORM.
If the result is non-nil, use VALUE instead of SPEC. */
iterate_out_of_display_property (it);
*position = it->position;
}
- /* If we were to display this fringe bitmap,
- next_element_from_image would have reset this flag.
- Do the same, to avoid affecting overlays that
- follow. */
- it->ignore_overlay_strings_at_pos_p = 0;
return 1;
}
}
iterate_out_of_display_property (it);
*position = it->position;
}
- if (it)
- /* Reset this flag like next_element_from_image would. */
- it->ignore_overlay_strings_at_pos_p = 0;
return 1;
}
{
Lisp_Object face_name = XCAR (XCDR (XCDR (spec)));
int face_id2 = lookup_derived_face (it->f, face_name,
- FRINGE_FACE_ID, 0);
+ FRINGE_FACE_ID, false);
if (face_id2 >= 0)
face_id = face_id2;
}
LOCATION specifies where to display: `left-margin',
`right-margin' or nil. */
- valid_p = (STRINGP (value)
+ bool valid_p = (STRINGP (value)
#ifdef HAVE_WINDOW_SYSTEM
- || ((it ? FRAME_WINDOW_P (it->f) : frame_window_p)
- && valid_image_p (value))
+ || ((it ? FRAME_WINDOW_P (it->f) : frame_window_p)
+ && valid_image_p (value))
#endif /* not HAVE_WINDOW_SYSTEM */
- || (CONSP (value) && EQ (XCAR (value), Qspace))
-#ifdef HAVE_XWIDGETS
- || ((it ? FRAME_WINDOW_P (it->f) : frame_window_p)
- && valid_xwidget_spec_p(value))
-#endif
- );
+ || (CONSP (value) && EQ (XCAR (value), Qspace)));
- if (valid_p && !display_replaced_p)
+ if (valid_p && display_replaced == 0)
{
int retval = 1;
it->bidi_it.string.s = NULL;
it->bidi_it.string.schars = it->end_charpos;
it->bidi_it.string.bufpos = bufpos;
- it->bidi_it.string.from_disp_str = 1;
+ it->bidi_it.string.from_disp_str = true;
it->bidi_it.string.unibyte = !it->multibyte_p;
it->bidi_it.w = it->w;
bidi_init_it (0, 0, FRAME_WINDOW_P (it->f), &it->bidi_it);
*position = it->position = start_pos;
retval = 1 + (it->area == TEXT_AREA);
}
-#ifdef HAVE_XWIDGETS
- else if (valid_xwidget_spec_p(value))
- {
- it->what = IT_XWIDGET;
- it->method = GET_FROM_XWIDGET;
- it->position = start_pos;
- it->object = NILP (object) ? it->w->contents : object;
- *position = start_pos;
-
- it->xwidget = lookup_xwidget(value);
- }
-#endif
#ifdef HAVE_WINDOW_SYSTEM
else
{
came, or nil if it came from a text property. CHARPOS and BYTEPOS
specify the buffer position covered by PROP. */
-int
+bool
display_prop_intangible_p (Lisp_Object prop, Lisp_Object overlay,
ptrdiff_t charpos, ptrdiff_t bytepos)
{
- int frame_window_p = FRAME_WINDOW_P (XFRAME (selected_frame));
+ bool frame_window_p = FRAME_WINDOW_P (XFRAME (selected_frame));
struct text_pos position;
SET_TEXT_POS (position, charpos, bytepos);
- return handle_display_spec (NULL, prop, Qnil, overlay,
- &position, charpos, frame_window_p);
+ return (handle_display_spec (NULL, prop, Qnil, overlay,
+ &position, charpos, frame_window_p)
+ != 0);
}
-/* Return 1 if PROP is a display sub-property value containing STRING.
+/* Return true if PROP is a display sub-property value containing STRING.
Implementation note: this and the following function are really
special cases of handle_display_spec and
Until they do, these two pairs must be consistent and must be
modified in sync. */
-static int
+static bool
single_display_spec_string_p (Lisp_Object prop, Lisp_Object string)
{
if (EQ (string, prop))
- return 1;
+ return true;
/* Skip over `when FORM'. */
if (CONSP (prop) && EQ (XCAR (prop), Qwhen))
{
prop = XCDR (prop);
if (!CONSP (prop))
- return 0;
+ return false;
/* Actually, the condition following `when' should be eval'ed,
like handle_single_display_spec does, and we should return
- zero if it evaluates to nil. However, this function is
+ false if it evaluates to nil. However, this function is
called only when the buffer was already displayed and some
glyph in the glyph matrix was found to come from a display
string. Therefore, the condition was already evaluated, and
{
prop = XCDR (prop);
if (!CONSP (prop))
- return 0;
+ return false;
prop = XCDR (prop);
if (!CONSP (prop))
- return 0;
+ return false;
}
return EQ (prop, string) || (CONSP (prop) && EQ (XCAR (prop), string));
}
-/* Return 1 if STRING appears in the `display' property PROP. */
+/* Return true if STRING appears in the `display' property PROP. */
-static int
+static bool
display_prop_string_p (Lisp_Object prop, Lisp_Object string)
{
if (CONSP (prop)
while (CONSP (prop))
{
if (single_display_spec_string_p (XCAR (prop), string))
- return 1;
+ return true;
prop = XCDR (prop);
}
}
ptrdiff_t i;
for (i = 0; i < ASIZE (prop); ++i)
if (single_display_spec_string_p (AREF (prop, i), string))
- return 1;
+ return true;
}
else
return single_display_spec_string_p (prop, string);
- return 0;
+ return false;
}
/* Look for STRING in overlays and text properties in the current
buffer, between character positions FROM and TO (excluding TO).
- BACK_P non-zero means look back (in this case, TO is supposed to be
+ BACK_P means look back (in this case, TO is supposed to be
less than FROM).
Value is the first character position where STRING was found, or
zero if it wasn't found before hitting TO.
static ptrdiff_t
string_buffer_position_lim (Lisp_Object string,
- ptrdiff_t from, ptrdiff_t to, int back_p)
+ ptrdiff_t from, ptrdiff_t to, bool back_p)
{
Lisp_Object limit, prop, pos;
- int found = 0;
+ bool found = false;
pos = make_number (max (from, BEGV));
{
prop = Fget_char_property (pos, Qdisplay, Qnil);
if (!NILP (prop) && display_prop_string_p (prop, string))
- found = 1;
+ found = true;
else
pos = Fnext_single_char_property_change (pos, Qdisplay, Qnil,
limit);
{
prop = Fget_char_property (pos, Qdisplay, Qnil);
if (!NILP (prop) && display_prop_string_p (prop, string))
- found = 1;
+ found = true;
else
pos = Fprevious_single_char_property_change (pos, Qdisplay, Qnil,
limit);
const int MAX_DISTANCE = 1000;
ptrdiff_t found = string_buffer_position_lim (string, around_charpos,
around_charpos + MAX_DISTANCE,
- 0);
+ false);
if (!found)
found = string_buffer_position_lim (string, around_charpos,
- around_charpos - MAX_DISTANCE, 1);
+ around_charpos - MAX_DISTANCE, true);
return found;
}
Lisp_Object overlay;
Lisp_Object string;
EMACS_INT priority;
- int after_string_p;
+ bool after_string_p;
};
they were before overlay strings were processed, and
continue to deliver from current_buffer. */
- it->ellipsis_p = (it->stack[it->sp - 1].display_ellipsis_p != 0);
+ it->ellipsis_p = it->stack[it->sp - 1].display_ellipsis_p;
pop_it (it);
eassert (it->sp > 0
|| (NILP (it->string)
&& it->stop_charpos <= it->end_charpos));
it->current.overlay_string_index = -1;
it->n_overlay_strings = 0;
- it->overlay_strings_charpos = -1;
/* If there's an empty display string on the stack, pop the
stack, to resync the bidi iterator with IT's position. Such
empty strings are pushed onto the stack in
if (it->sp > 0 && STRINGP (it->string) && !SCHARS (it->string))
pop_it (it);
+ /* Since we've exhausted overlay strings at this buffer
+ position, set the flag to ignore overlays until we move to
+ another position. The flag is reset in
+ next_element_from_buffer. */
+ it->ignore_overlay_strings_at_pos_p = true;
+
/* If we're at the end of the buffer, record that we have
processed the overlay strings there already, so that
next_element_from_buffer doesn't try it again. */
- if (NILP (it->string) && IT_CHARPOS (*it) >= it->end_charpos)
+ if (NILP (it->string)
+ && IT_CHARPOS (*it) >= it->end_charpos
+ && it->overlay_strings_charpos >= it->end_charpos)
it->overlay_strings_at_end_processed_p = true;
+ /* Note: we reset overlay_strings_charpos only here, to make
+ sure the just-processed overlays were indeed at EOB.
+ Otherwise, overlays on text with invisible text property,
+ which are processed with IT's position past the invisible
+ text, might fool us into thinking the overlays at EOB were
+ already processed (linum-mode can cause this, for
+ example). */
+ it->overlay_strings_charpos = -1;
}
else
{
struct Lisp_Overlay *ov;
ptrdiff_t start, end;
ptrdiff_t n = 0, i, j;
- int invis_p;
+ int invis;
struct overlay_entry entriesbuf[20];
ptrdiff_t size = ARRAYELTS (entriesbuf);
struct overlay_entry *entries = entriesbuf;
/* Append the overlay string STRING of overlay OVERLAY to vector
`entries' which has size `size' and currently contains `n'
- elements. AFTER_P non-zero means STRING is an after-string of
+ elements. AFTER_P means STRING is an after-string of
OVERLAY. */
#define RECORD_OVERLAY_STRING(OVERLAY, STRING, AFTER_P) \
do \
entries[n].after_string_p = (AFTER_P); \
++n; \
} \
- while (0)
+ while (false)
/* Process overlay before the overlay center. */
for (ov = current_buffer->overlays_before; ov; ov = ov->next)
and after-strings from this overlay are visible; start and
end position are indistinguishable. */
invisible = Foverlay_get (overlay, Qinvisible);
- invis_p = TEXT_PROP_MEANS_INVISIBLE (invisible);
+ invis = TEXT_PROP_MEANS_INVISIBLE (invisible);
/* If overlay has a non-empty before-string, record it. */
- if ((start == charpos || (end == charpos && invis_p))
+ if ((start == charpos || (end == charpos && invis != 0))
&& (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))
&& SCHARS (str))
- RECORD_OVERLAY_STRING (overlay, str, 0);
+ RECORD_OVERLAY_STRING (overlay, str, false);
/* If overlay has a non-empty after-string, record it. */
- if ((end == charpos || (start == charpos && invis_p))
+ if ((end == charpos || (start == charpos && invis != 0))
&& (str = Foverlay_get (overlay, Qafter_string), STRINGP (str))
&& SCHARS (str))
- RECORD_OVERLAY_STRING (overlay, str, 1);
+ RECORD_OVERLAY_STRING (overlay, str, true);
}
/* Process overlays after the overlay center. */
/* If the text ``under'' the overlay is invisible, it has a zero
dimension, and both before- and after-strings apply. */
invisible = Foverlay_get (overlay, Qinvisible);
- invis_p = TEXT_PROP_MEANS_INVISIBLE (invisible);
+ invis = TEXT_PROP_MEANS_INVISIBLE (invisible);
/* If overlay has a non-empty before-string, record it. */
- if ((start == charpos || (end == charpos && invis_p))
+ if ((start == charpos || (end == charpos && invis != 0))
&& (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))
&& SCHARS (str))
- RECORD_OVERLAY_STRING (overlay, str, 0);
+ RECORD_OVERLAY_STRING (overlay, str, false);
/* If overlay has a non-empty after-string, record it. */
- if ((end == charpos || (start == charpos && invis_p))
+ if ((end == charpos || (start == charpos && invis != 0))
&& (str = Foverlay_get (overlay, Qafter_string), STRINGP (str))
&& SCHARS (str))
- RECORD_OVERLAY_STRING (overlay, str, 1);
+ RECORD_OVERLAY_STRING (overlay, str, true);
}
#undef RECORD_OVERLAY_STRING
/* Get the first chunk of overlay strings at IT's current buffer
- position, or at CHARPOS if that is > 0. Value is non-zero if at
+ position, or at CHARPOS if that is > 0. Value is true if at
least one overlay string was found. */
-static int
-get_overlay_strings_1 (struct it *it, ptrdiff_t charpos, int compute_stop_p)
+static bool
+get_overlay_strings_1 (struct it *it, ptrdiff_t charpos, bool compute_stop_p)
{
/* Get the first OVERLAY_STRING_CHUNK_SIZE overlay strings to
process. This fills IT->overlay_strings with strings, and sets
it->bidi_it.w = it->w;
bidi_init_it (0, 0, FRAME_WINDOW_P (it->f), &it->bidi_it);
}
- return 1;
+ return true;
}
it->current.overlay_string_index = -1;
- return 0;
+ return false;
}
-static int
+static bool
get_overlay_strings (struct it *it, ptrdiff_t charpos)
{
it->string = Qnil;
it->method = GET_FROM_BUFFER;
- (void) get_overlay_strings_1 (it, charpos, 1);
+ get_overlay_strings_1 (it, charpos, true);
CHECK_IT (it);
- /* Value is non-zero if we found at least one overlay string. */
+ /* Value is true if we found at least one overlay string. */
return STRINGP (it->string);
}
case GET_FROM_STRETCH:
p->u.stretch.object = it->object;
break;
-#ifdef HAVE_XWIDGETS
- case GET_FROM_XWIDGET:
- p->u.xwidget.object = it->object;
- break;
-#endif
}
p->position = position ? *position : it->position;
p->current = it->current;
p->voffset = it->voffset;
p->string_from_display_prop_p = it->string_from_display_prop_p;
p->string_from_prefix_prop_p = it->string_from_prefix_prop_p;
- p->display_ellipsis_p = 0;
+ p->display_ellipsis_p = false;
p->line_wrap = it->line_wrap;
p->bidi_p = it->bidi_p;
p->paragraph_embedding = it->paragraph_embedding;
static void
iterate_out_of_display_property (struct it *it)
{
- int buffer_p = !STRINGP (it->string);
+ bool buffer_p = !STRINGP (it->string);
ptrdiff_t eob = (buffer_p ? ZV : it->end_charpos);
ptrdiff_t bob = (buffer_p ? BEGV : 0);
of a new paragraph, next_element_from_buffer may not have a
chance to do that. */
if (it->bidi_it.first_elt && it->bidi_it.charpos < eob)
- bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, 1);
+ bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, true);
/* prev_stop can be zero, so check against BEGV as well. */
while (it->bidi_it.charpos >= bob
&& it->prev_stop <= it->bidi_it.charpos
pop_it (struct it *it)
{
struct iterator_stack_entry *p;
- int from_display_prop = it->from_disp_prop_p;
+ bool from_display_prop = it->from_disp_prop_p;
eassert (it->sp > 0);
--it->sp;
it->object = p->u.image.object;
it->slice = p->u.image.slice;
break;
-#ifdef HAVE_XWIDGETS
- case GET_FROM_XWIDGET:
- it->object = p->u.xwidget.object;
- break;
-#endif
case GET_FROM_STRETCH:
it->object = p->u.stretch.object;
break;
/* Move IT to the next line start.
- Value is non-zero if a newline was found. Set *SKIPPED_P to 1 if
+ Value is true if a newline was found. Set *SKIPPED_P to true if
we skipped over part of the text (as opposed to moving the iterator
continuously over the text). Otherwise, don't change the value
of *SKIPPED_P.
characters following a newline part of the wrong glyph row, which
leads to wrong cursor motion. */
-static int
-forward_to_next_line_start (struct it *it, int *skipped_p,
+static bool
+forward_to_next_line_start (struct it *it, bool *skipped_p,
struct bidi_it *bidi_it_prev)
{
ptrdiff_t old_selective;
- int newline_found_p, n;
+ bool newline_found_p = false;
+ int n;
const int MAX_NEWLINE_DISTANCE = 500;
/* If already on a newline, just consume it to avoid unintended
{
if (it->bidi_p && bidi_it_prev)
*bidi_it_prev = it->bidi_it;
- set_iterator_to_next (it, 0);
+ set_iterator_to_next (it, false);
it->c = 0;
- return 1;
+ return true;
}
/* Don't handle selective display in the following. It's (a)
/* Scan for a newline within MAX_NEWLINE_DISTANCE display elements
from buffer text. */
- for (n = newline_found_p = 0;
+ for (n = 0;
!newline_found_p && n < MAX_NEWLINE_DISTANCE;
- n += STRINGP (it->string) ? 0 : 1)
+ n += !STRINGP (it->string))
{
if (!get_next_display_element (it))
- return 0;
+ return false;
newline_found_p = it->what == IT_CHARACTER && it->c == '\n';
if (newline_found_p && it->bidi_p && bidi_it_prev)
*bidi_it_prev = it->bidi_it;
- set_iterator_to_next (it, 0);
+ set_iterator_to_next (it, false);
}
/* If we didn't find a newline near enough, see if we can use a
newline_found_p = ITERATOR_AT_END_OF_LINE_P (it);
if (newline_found_p && it->bidi_p && bidi_it_prev)
*bidi_it_prev = it->bidi_it;
- set_iterator_to_next (it, 0);
+ set_iterator_to_next (it, false);
}
}
}
Lisp_Object prop;
prop = Fget_char_property (make_number (IT_CHARPOS (*it) - 1),
Qinvisible, it->window);
- if (TEXT_PROP_MEANS_INVISIBLE (prop))
+ if (TEXT_PROP_MEANS_INVISIBLE (prop) != 0)
continue;
}
pos = --IT_CHARPOS (it2);
--IT_BYTEPOS (it2);
it2.sp = 0;
- bidi_unshelve_cache (NULL, 0);
- it2.string_from_display_prop_p = 0;
- it2.from_disp_prop_p = 0;
+ bidi_unshelve_cache (NULL, false);
+ it2.string_from_display_prop_p = false;
+ it2.from_disp_prop_p = false;
if (handle_display_prop (&it2) == HANDLED_RETURN
&& !NILP (val = get_char_property_and_overlay
(make_number (pos), Qdisplay, Qnil, &overlay))
reseat_at_previous_visible_line_start (struct it *it)
{
back_to_previous_visible_line_start (it);
- reseat (it, it->current.pos, 1);
+ reseat (it, it->current.pos, true);
CHECK_IT (it);
}
/* Reseat iterator IT on the next visible line start in the current
- buffer. ON_NEWLINE_P non-zero means position IT on the newline
+ buffer. ON_NEWLINE_P means position IT on the newline
preceding the line start. Skip over invisible text that is so
because of selective display. Compute faces, overlays etc at the
new position. Note that this function does not skip over text that
is invisible because of text properties. */
static void
-reseat_at_next_visible_line_start (struct it *it, int on_newline_p)
+reseat_at_next_visible_line_start (struct it *it, bool on_newline_p)
{
- int newline_found_p, skipped_p = 0;
+ bool skipped_p = false;
struct bidi_it bidi_it_prev;
-
- newline_found_p = forward_to_next_line_start (it, &skipped_p, &bidi_it_prev);
+ bool newline_found_p
+ = forward_to_next_line_start (it, &skipped_p, &bidi_it_prev);
/* Skip over lines that are invisible because they are indented
more than the value of IT->selective. */
IT_CHARPOS (*it) = it->bidi_it.charpos;
IT_BYTEPOS (*it) = it->bidi_it.bytepos;
}
- reseat (it, it->current.pos, 0);
+ reseat (it, it->current.pos, false);
}
}
else if (skipped_p)
- reseat (it, it->current.pos, 0);
+ reseat (it, it->current.pos, false);
CHECK_IT (it);
}
Changing an iterator's position
***********************************************************************/
-/* Change IT's current position to POS in current_buffer. If FORCE_P
- is non-zero, always check for text properties at the new position.
+/* Change IT's current position to POS in current_buffer.
+ If FORCE_P, always check for text properties at the new position.
Otherwise, text properties are only looked up if POS >=
IT->check_charpos of a property. */
static void
-reseat (struct it *it, struct text_pos pos, int force_p)
+reseat (struct it *it, struct text_pos pos, bool force_p)
{
ptrdiff_t original_pos = IT_CHARPOS (*it);
- reseat_1 (it, pos, 0);
+ reseat_1 (it, pos, false);
/* Determine where to check text properties. Avoid doing it
where possible because text property lookup is very expensive. */
}
-/* Change IT's buffer position to POS. SET_STOP_P non-zero means set
+/* Change IT's buffer position to POS. SET_STOP_P means set
IT->stop_pos to POS, also. */
static void
-reseat_1 (struct it *it, struct text_pos pos, int set_stop_p)
+reseat_1 (struct it *it, struct text_pos pos, bool set_stop_p)
{
/* Don't call this function when scanning a C string. */
eassert (it->s == NULL);
it->area = TEXT_AREA;
it->multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters));
it->sp = 0;
- it->string_from_display_prop_p = 0;
- it->string_from_prefix_prop_p = 0;
+ it->string_from_display_prop_p = false;
+ it->string_from_prefix_prop_p = false;
- it->from_disp_prop_p = 0;
- it->face_before_selective_p = 0;
+ it->from_disp_prop_p = false;
+ it->face_before_selective_p = false;
if (it->bidi_p)
{
bidi_init_it (IT_CHARPOS (*it), IT_BYTEPOS (*it), FRAME_WINDOW_P (it->f),
&it->bidi_it);
- bidi_unshelve_cache (NULL, 0);
+ bidi_unshelve_cache (NULL, false);
it->bidi_it.paragraph_dir = NEUTRAL_DIR;
it->bidi_it.string.s = NULL;
it->bidi_it.string.lstring = Qnil;
it->bidi_it.string.bufpos = 0;
- it->bidi_it.string.from_disp_str = 0;
- it->bidi_it.string.unibyte = 0;
+ it->bidi_it.string.from_disp_str = false;
+ it->bidi_it.string.unibyte = false;
it->bidi_it.w = it->w;
}
it->bidi_it.string.s = NULL;
it->bidi_it.string.schars = it->end_charpos;
it->bidi_it.string.bufpos = 0;
- it->bidi_it.string.from_disp_str = 0;
+ it->bidi_it.string.from_disp_str = false;
it->bidi_it.string.unibyte = !it->multibyte_p;
it->bidi_it.w = it->w;
bidi_init_it (charpos, IT_STRING_BYTEPOS (*it),
IT_STRING_CHARPOS (*it) = IT_STRING_BYTEPOS (*it) = -1;
if (it->multibyte_p)
{
- it->current.pos = c_string_pos (charpos, s, 1);
- it->end_charpos = it->string_nchars = number_of_chars (s, 1);
+ it->current.pos = c_string_pos (charpos, s, true);
+ it->end_charpos = it->string_nchars = number_of_chars (s, true);
}
else
{
it->bidi_it.string.s = (const unsigned char *) s;
it->bidi_it.string.schars = it->end_charpos;
it->bidi_it.string.bufpos = 0;
- it->bidi_it.string.from_disp_str = 0;
+ it->bidi_it.string.from_disp_str = false;
it->bidi_it.string.unibyte = !it->multibyte_p;
it->bidi_it.w = it->w;
bidi_init_it (charpos, IT_BYTEPOS (*it), FRAME_WINDOW_P (it->f),
it->base_level_stop = 0;
if (it->bidi_p)
{
- it->bidi_it.first_elt = 1;
+ it->bidi_it.first_elt = true;
it->bidi_it.paragraph_dir = NEUTRAL_DIR;
it->bidi_it.disp_pos = -1;
}
/* Map enum it_method value to corresponding next_element_from_* function. */
-static int (* get_next_element[NUM_IT_METHODS]) (struct it *it) =
+typedef bool (*next_element_function) (struct it *);
+
+static next_element_function const get_next_element[NUM_IT_METHODS] =
{
next_element_from_buffer,
next_element_from_display_vector,
next_element_from_c_string,
next_element_from_image,
next_element_from_stretch
-#ifdef HAVE_XWIDGETS
- ,next_element_from_xwidget
-#endif
};
#define GET_NEXT_DISPLAY_ELEMENT(it) (*get_next_element[(it)->method]) (it)
-/* Return 1 iff a character at CHARPOS (and BYTEPOS) is composed
+/* Return true iff a character at CHARPOS (and BYTEPOS) is composed
(possibly with the following characters). */
#define CHAR_COMPOSED_P(IT,CHARPOS,BYTEPOS,END_CHARPOS) \
}
/* Load IT's display element fields with information about the next
- display element from the current position of IT. Value is zero if
+ display element from the current position of IT. Value is false if
end of buffer (or C string) is reached. */
-static int
+static bool
get_next_display_element (struct it *it)
{
- /* Non-zero means that we found a display element. Zero means that
+ /* True means that we found a display element. False means that
we hit the end of what we iterate over. Performance note: the
function pointer `method' used here turns out to be faster than
using a sequence of if-statements. */
- int success_p;
+ bool success_p;
get_next:
success_p = GET_NEXT_DISPLAY_ELEMENT (it);
{
Lisp_Object dv;
struct charset *unibyte = CHARSET_FROM_ID (charset_unibyte);
- int nonascii_space_p = 0;
- int nonascii_hyphen_p = 0;
+ bool nonascii_space_p = false;
+ bool nonascii_hyphen_p = false;
int c = it->c; /* This is the character to display. */
if (! it->multibyte_p && ! ASCII_CHAR_P (c))
it->dpvec_face_id = -1;
it->saved_face_id = it->face_id;
it->method = GET_FROM_DISPLAY_VECTOR;
- it->ellipsis_p = 0;
+ it->ellipsis_p = false;
}
else
{
- set_iterator_to_next (it, 0);
+ set_iterator_to_next (it, false);
}
goto get_next;
}
if (it->what == IT_GLYPHLESS)
goto done;
/* Don't display this character. */
- set_iterator_to_next (it, 0);
+ set_iterator_to_next (it, false);
goto get_next;
}
it->dpvec_face_id = face_id;
it->saved_face_id = it->face_id;
it->method = GET_FROM_DISPLAY_VECTOR;
- it->ellipsis_p = 0;
+ it->ellipsis_p = false;
goto get_next;
}
it->char_to_display = c;
done:
/* Is this character the last one of a run of characters with
- box? If yes, set IT->end_of_box_run_p to 1. */
+ box? If yes, set IT->end_of_box_run_p to true. */
if (it->face_box_p
&& it->s == NULL)
{
/* If we reached the end of the object we've been iterating (e.g., a
display string or an overlay string), and there's something on
IT->stack, proceed with what's on the stack. It doesn't make
- sense to return zero if there's unprocessed stuff on the stack,
+ sense to return false if there's unprocessed stuff on the stack,
because otherwise that stuff will never be displayed. */
if (!success_p && it->sp > 0)
{
- set_iterator_to_next (it, 0);
+ set_iterator_to_next (it, false);
success_p = get_next_display_element (it);
}
- /* Value is 0 if end of buffer or string reached. */
+ /* Value is false if end of buffer or string reached. */
return success_p;
}
/* Move IT to the next display element.
- RESEAT_P non-zero means if called on a newline in buffer text,
+ RESEAT_P means if called on a newline in buffer text,
skip to the next visible line start.
Functions get_next_display_element and set_iterator_to_next are
decrement position function which would not be easy to write. */
void
-set_iterator_to_next (struct it *it, int reseat_p)
+set_iterator_to_next (struct it *it, bool reseat_p)
{
/* Reset flags indicating start and end of a sequence of characters
with box. Reset them at the start of this function because
moving the iterator to a new position might set them. */
- it->start_of_box_run_p = it->end_of_box_run_p = 0;
+ it->start_of_box_run_p = it->end_of_box_run_p = false;
switch (it->method)
{
current_buffer. Advance in the buffer, and maybe skip over
invisible lines that are so because of selective display. */
if (ITERATOR_AT_END_OF_LINE_P (it) && reseat_p)
- reseat_at_next_visible_line_start (it, 0);
+ reseat_at_next_visible_line_start (it, false);
else if (it->cmp_it.id >= 0)
{
/* We are currently getting glyphs from a composition. */
/* If this is a new paragraph, determine its base
direction (a.k.a. its base embedding level). */
if (it->bidi_it.new_paragraph)
- bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, 0);
+ bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it,
+ false);
bidi_move_to_visually_next (&it->bidi_it);
IT_BYTEPOS (*it) = it->bidi_it.bytepos;
IT_CHARPOS (*it) = it->bidi_it.charpos;
if (it->dpvec + it->current.dpvec_index >= it->dpend)
{
- int recheck_faces = it->ellipsis_p;
+ bool recheck_faces = it->ellipsis_p;
if (it->s)
it->method = GET_FROM_C_STRING;
/* Skip over characters which were displayed via IT->dpvec. */
if (it->dpvec_char_len < 0)
- reseat_at_next_visible_line_start (it, 1);
+ reseat_at_next_visible_line_start (it, true);
else if (it->dpvec_char_len > 0)
{
- if (it->method == GET_FROM_STRING
- && it->current.overlay_string_index >= 0
- && it->n_overlay_strings > 0)
- it->ignore_overlay_strings_at_pos_p = true;
it->len = it->dpvec_char_len;
set_iterator_to_next (it, reseat_p);
}
/* Maybe recheck faces after display vector. */
if (recheck_faces)
- it->stop_charpos = IT_CHARPOS (*it);
+ {
+ if (it->method == GET_FROM_STRING)
+ it->stop_charpos = IT_STRING_CHARPOS (*it);
+ else
+ it->stop_charpos = IT_CHARPOS (*it);
+ }
}
break;
next, if there is one. */
if (IT_STRING_CHARPOS (*it) >= SCHARS (it->string))
{
- it->ellipsis_p = 0;
+ it->ellipsis_p = false;
next_overlay_string (it);
if (it->ellipsis_p)
setup_for_ellipsis (it, 0);
case GET_FROM_IMAGE:
case GET_FROM_STRETCH:
-#ifdef HAVE_XWIDGETS
- case GET_FROM_XWIDGET:
-#endif
-
/* 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. */
IT->saved_face_id holds the face id before the display vector--it
is restored into IT->face_id in set_iterator_to_next. */
-static int
+static bool
next_element_from_display_vector (struct it *it)
{
Lisp_Object gc;
still the values of the character that had this display table
entry or was translated, and that's what we want. */
it->what = IT_CHARACTER;
- return 1;
+ return true;
}
/* Get the first element of string/buffer in the visual order, after
static void
get_visually_first_element (struct it *it)
{
- int string_p = STRINGP (it->string) || it->s;
+ bool string_p = STRINGP (it->string) || it->s;
ptrdiff_t eob = (string_p ? it->bidi_it.string.schars : ZV);
ptrdiff_t bob = (string_p ? 0 : BEGV);
/* Nothing to do, but reset the FIRST_ELT flag, like
bidi_paragraph_init does, because we are not going to
call it. */
- it->bidi_it.first_elt = 0;
+ it->bidi_it.first_elt = false;
}
else if (it->bidi_it.charpos == bob
|| (!string_p
{
/* If we are at the beginning of a line/string, we can produce
the next element right away. */
- bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, 1);
+ bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, true);
bidi_move_to_visually_next (&it->bidi_it);
}
else
it->bidi_it.charpos = find_newline_no_quit (IT_CHARPOS (*it),
IT_BYTEPOS (*it), -1,
&it->bidi_it.bytepos);
- bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, 1);
+ bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, true);
do
{
/* Now return to buffer/string position where we were asked
If IT->current.overlay_string_index >= 0, the Lisp string is an
overlay string. */
-static int
+static bool
next_element_from_string (struct it *it)
{
struct text_pos position;
position = it->current.string_pos;
/* With bidi reordering, the character to display might not be the
- character at IT_STRING_CHARPOS. BIDI_IT.FIRST_ELT non-zero means
+ character at IT_STRING_CHARPOS. BIDI_IT.FIRST_ELT means
that we were reseat()ed to a new string, whose paragraph
direction is not known. */
if (it->bidi_p && it->bidi_it.first_elt)
if (IT_STRING_CHARPOS (*it) >= SCHARS (it->string))
{
it->what = IT_EOB;
- return 0;
+ return false;
}
else if (CHAR_COMPOSED_P (it, IT_STRING_CHARPOS (*it),
IT_STRING_BYTEPOS (*it),
: SCHARS (it->string))
&& next_element_from_composition (it))
{
- return 1;
+ return true;
}
else if (STRING_MULTIBYTE (it->string))
{
if (IT_STRING_CHARPOS (*it) >= it->end_charpos)
{
it->what = IT_EOB;
- return 0;
+ return false;
}
else if (IT_STRING_CHARPOS (*it) >= it->string_nchars)
{
: it->string_nchars)
&& next_element_from_composition (it))
{
- return 1;
+ return true;
}
else if (STRING_MULTIBYTE (it->string))
{
it->what = IT_CHARACTER;
it->object = it->string;
it->position = position;
- return 1;
+ return true;
}
IT->string_nchars is the maximum number of characters to return
from the string. IT->end_charpos may be greater than
IT->string_nchars when this function is called, in which case we
- may have to return padding spaces. Value is zero if end of string
+ may have to return padding spaces. Value is false if end of string
reached, including padding spaces. */
-static int
+static bool
next_element_from_c_string (struct it *it)
{
bool success_p = true;
it->object = make_number (0);
/* With bidi reordering, the character to display might not be the
- character at IT_CHARPOS. BIDI_IT.FIRST_ELT non-zero means that
+ character at IT_CHARPOS. BIDI_IT.FIRST_ELT means that
we were reseated to a new string, whose paragraph direction is
not known. */
if (it->bidi_p && it->bidi_it.first_elt)
{
/* End of the game. */
it->what = IT_EOB;
- success_p = 0;
+ success_p = false;
}
else if (IT_CHARPOS (*it) >= it->string_nchars)
{
entry. This function fills IT with the first glyph from the
ellipsis if an ellipsis is to be displayed. */
-static int
+static bool
next_element_from_ellipsis (struct it *it)
{
if (it->selective_display_ellipsis_p)
it->saved_face_id = it->face_id;
it->method = GET_FROM_BUFFER;
it->object = it->w->contents;
- reseat_at_next_visible_line_start (it, 1);
+ reseat_at_next_visible_line_start (it, true);
it->face_before_selective_p = true;
}
/* Deliver an image display element. The iterator IT is already
filled with image information (done in handle_display_prop). Value
- is always 1. */
+ is always true. */
-static int
+static bool
next_element_from_image (struct it *it)
{
it->what = IT_IMAGE;
- it->ignore_overlay_strings_at_pos_p = 0;
- return 1;
-}
-
-#ifdef HAVE_XWIDGETS
-/* im not sure about this FIXME JAVE*/
-static int
-next_element_from_xwidget (struct it *it)
-{
- it->what = IT_XWIDGET;
- return 1;
+ return true;
}
-#endif
/* Fill iterator IT with next display element from a stretch glyph
property. IT->object is the value of the text property. Value is
- always 1. */
+ always true. */
-static int
+static bool
next_element_from_stretch (struct it *it)
{
it->what = IT_STRETCH;
- return 1;
+ return true;
}
/* Scan backwards from IT's current position until we find a stop
eassert (NILP (it->string) && !it->s);
eassert (it->bidi_p);
- it->bidi_p = 0;
+ it->bidi_p = false;
do
{
it->end_charpos = min (charpos + 1, ZV);
charpos = max (charpos - SCAN_BACK_LIMIT, BEGV);
SET_TEXT_POS (pos, charpos, CHAR_TO_BYTE (charpos));
- reseat_1 (it, pos, 0);
+ reseat_1 (it, pos, false);
compute_stop_pos (it);
/* We must advance forward, right? */
if (it->stop_charpos <= charpos)
static void
handle_stop_backwards (struct it *it, ptrdiff_t charpos)
{
- int bufp = !STRINGP (it->string);
+ bool bufp = !STRINGP (it->string);
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;
/* Scan in strict logical order. */
eassert (it->bidi_p);
- it->bidi_p = 0;
+ it->bidi_p = false;
do
{
it->prev_stop = charpos;
if (bufp)
{
SET_TEXT_POS (pos1, charpos, CHAR_TO_BYTE (charpos));
- reseat_1 (it, pos1, 0);
+ reseat_1 (it, pos1, false);
}
else
it->current.string_pos = string_pos (charpos, it->string);
}
/* Load IT with the next display element from current_buffer. Value
- is zero if end of buffer reached. IT->stop_charpos is the next
+ is false if end of buffer reached. IT->stop_charpos is the next
position at which to stop and check for text properties or buffer
end. */
-static int
+static bool
next_element_from_buffer (struct it *it)
{
bool success_p = true;
&& it->bidi_it.string.s == NULL));
/* With bidi reordering, the character to display might not be the
- character at IT_CHARPOS. BIDI_IT.FIRST_ELT non-zero means that
+ character at IT_CHARPOS. BIDI_IT.FIRST_ELT means that
we were reseat()ed to a new buffer position, which is potentially
a different paragraph. */
if (it->bidi_p && it->bidi_it.first_elt)
{
if (IT_CHARPOS (*it) >= it->end_charpos)
{
- int overlay_strings_follow_p;
+ bool overlay_strings_follow_p;
/* End of the game, except when overlay strings follow that
haven't been returned yet. */
if (it->overlay_strings_at_end_processed_p)
- overlay_strings_follow_p = 0;
+ overlay_strings_follow_p = false;
else
{
it->overlay_strings_at_end_processed_p = true;
{
it->what = IT_EOB;
it->position = it->current.pos;
- success_p = 0;
+ success_p = false;
}
}
else if (!(!it->bidi_p
and handle the last stop_charpos that precedes our
current position. */
handle_stop_backwards (it, it->stop_charpos);
+ it->ignore_overlay_strings_at_pos_p = false;
return GET_NEXT_DISPLAY_ELEMENT (it);
}
else
it->base_level_stop = it->stop_charpos;
}
handle_stop (it);
+ it->ignore_overlay_strings_at_pos_p = false;
return GET_NEXT_DISPLAY_ELEMENT (it);
}
}
}
else
handle_stop_backwards (it, it->base_level_stop);
+ it->ignore_overlay_strings_at_pos_p = false;
return GET_NEXT_DISPLAY_ELEMENT (it);
}
else
/* We moved to the next buffer position, so any info about
previously seen overlays is no longer valid. */
- it->ignore_overlay_strings_at_pos_p = 0;
+ it->ignore_overlay_strings_at_pos_p = false;
/* Maybe run the redisplay end trigger hook. Performance note:
This doesn't seem to cost measurable time. */
stop)
&& next_element_from_composition (it))
{
- return 1;
+ return true;
}
/* Get the next character, maybe multibyte. */
}
}
- /* Value is zero if end of buffer reached. */
+ /* Value is false if end of buffer reached. */
eassert (!success_p || it->what != IT_CHARACTER || it->len > 0);
return success_p;
}
get_next_element[]. It is called from next_element_from_buffer and
next_element_from_string when necessary. */
-static int
+static bool
next_element_from_composition (struct it *it)
{
it->what = IT_COMPOSITION;
{
IT_STRING_CHARPOS (*it) += it->cmp_it.nchars;
IT_STRING_BYTEPOS (*it) += it->cmp_it.nbytes;
- return 0;
+ return false;
}
it->position = it->current.string_pos;
it->object = it->string;
if (it->bidi_p)
{
if (it->bidi_it.new_paragraph)
- bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it, 0);
+ bidi_paragraph_init (it->paragraph_embedding, &it->bidi_it,
+ false);
/* Resync the bidi iterator with IT's new position.
FIXME: this doesn't support bidirectional text. */
while (it->bidi_it.charpos < IT_CHARPOS (*it))
bidi_move_to_visually_next (&it->bidi_it);
}
- return 0;
+ return false;
}
it->position = it->current.pos;
it->object = it->w->contents;
it->c = composition_update_it (&it->cmp_it, IT_CHARPOS (*it),
IT_BYTEPOS (*it), Qnil);
}
- return 1;
+ return true;
}
position after some move_it_ call. */
#define IT_POS_VALID_AFTER_MOVE_P(it) \
- ((it)->method == GET_FROM_STRING \
- ? IT_STRING_CHARPOS (*it) == 0 \
- : 1)
+ ((it)->method != GET_FROM_STRING || IT_STRING_CHARPOS (*it) == 0)
/* Move iterator IT to a specified buffer or X position within one
struct it wrap_it, atpos_it, atx_it, ppos_it;
void *wrap_data = NULL, *atpos_data = NULL, *atx_data = NULL;
void *ppos_data = NULL;
- int may_wrap = 0;
+ bool may_wrap = false;
enum it_method prev_method = it->method;
ptrdiff_t closest_pos IF_LINT (= 0), prev_pos = IT_CHARPOS (*it);
- int saw_smaller_pos = prev_pos < to_charpos;
+ bool saw_smaller_pos = prev_pos < to_charpos;
/* Don't produce glyphs in produce_glyphs. */
saved_glyph_row = it->glyph_row;
if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos))
SET_TEXT_POS (this_line_min_pos, IT_CHARPOS (*it), IT_BYTEPOS (*it));
- while (1)
+ while (true)
{
int x, i, ascent = 0, descent = 0;
if (it->line_wrap == WORD_WRAP && it->area == TEXT_AREA)
{
if (IT_DISPLAYING_WHITESPACE (it))
- may_wrap = 1;
+ may_wrap = true;
else if (may_wrap)
{
/* We have reached a glyph that follows one or more
}
/* Otherwise, we can wrap here. */
SAVE_IT (wrap_it, *it, wrap_data);
- may_wrap = 0;
+ may_wrap = false;
}
}
}
prev_method = it->method;
if (it->method == GET_FROM_BUFFER)
prev_pos = IT_CHARPOS (*it);
- set_iterator_to_next (it, 1);
+ set_iterator_to_next (it, true);
if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos))
SET_TEXT_POS (this_line_min_pos,
IT_CHARPOS (*it), IT_BYTEPOS (*it));
if (BUFFER_POS_REACHED_P ())
{
if (it->line_wrap != WORD_WRAP
- || wrap_it.sp < 0)
+ || wrap_it.sp < 0
+ /* If we've just found whitespace to
+ wrap, effectively ignore the
+ previous wrap point -- it is no
+ longer relevant, but we won't
+ have an opportunity to update it,
+ since we've reached the edge of
+ this screen line. */
+ || (may_wrap
+ && IT_OVERFLOW_NEWLINE_INTO_FRINGE (it)))
{
it->hpos = hpos_before_this_char;
it->current_x = x_before_this_char;
prev_method = it->method;
if (it->method == GET_FROM_BUFFER)
prev_pos = IT_CHARPOS (*it);
- set_iterator_to_next (it, 1);
+ set_iterator_to_next (it, true);
if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos))
SET_TEXT_POS (this_line_min_pos,
IT_CHARPOS (*it), IT_BYTEPOS (*it));
else
IT_RESET_X_ASCENT_DESCENT (it);
- if (wrap_it.sp >= 0)
+ /* If the screen line ends with whitespace, and we
+ are under word-wrap, don't use wrap_it: it is no
+ longer relevant, but we won't have an opportunity
+ to update it, since we are done with this screen
+ line. */
+ if (may_wrap && IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
+ {
+ /* If we've found TO_X, go back there, as we now
+ know the last word fits on this screen line. */
+ if ((op & MOVE_TO_X) && new_x == it->last_visible_x
+ && atx_it.sp >= 0)
+ {
+ RESTORE_IT (it, &atx_it, atx_data);
+ atpos_it.sp = -1;
+ atx_it.sp = -1;
+ result = MOVE_X_REACHED;
+ break;
+ }
+ }
+ else if (wrap_it.sp >= 0)
{
RESTORE_IT (it, &wrap_it, wrap_data);
atpos_it.sp = -1;
prev_pos = IT_CHARPOS (*it);
/* The current display element has been consumed. Advance
to the next. */
- set_iterator_to_next (it, 1);
+ set_iterator_to_next (it, true);
if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos))
SET_TEXT_POS (this_line_min_pos, IT_CHARPOS (*it), IT_BYTEPOS (*it));
if (IT_CHARPOS (*it) < to_charpos)
- saw_smaller_pos = 1;
+ saw_smaller_pos = true;
if (it->bidi_p
&& (op & MOVE_TO_POS)
&& IT_CHARPOS (*it) >= to_charpos
: WINDOW_RIGHT_FRINGE_WIDTH (it->w)) == 0
|| IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
{
- int at_eob_p = 0;
+ bool at_eob_p = false;
if ((at_eob_p = !get_next_display_element (it))
|| BUFFER_POS_REACHED_P ()
done:
if (atpos_data)
- bidi_unshelve_cache (atpos_data, 1);
+ bidi_unshelve_cache (atpos_data, true);
if (atx_data)
- bidi_unshelve_cache (atx_data, 1);
+ bidi_unshelve_cache (atx_data, true);
if (wrap_data)
- bidi_unshelve_cache (wrap_data, 1);
+ bidi_unshelve_cache (wrap_data, true);
if (ppos_data)
- bidi_unshelve_cache (ppos_data, 1);
+ bidi_unshelve_cache (ppos_data, true);
/* Restore the iterator settings altered at the beginning of this
function. */
(it, -1, prev_x, MOVE_TO_X);
}
else
- bidi_unshelve_cache (save_data, 1);
+ bidi_unshelve_cache (save_data, true);
}
else
move_it_in_display_line_to (it, to_charpos, to_x, op);
case MOVE_NEWLINE_OR_CR:
max_current_x = max (it->current_x, max_current_x);
- set_iterator_to_next (it, 1);
+ set_iterator_to_next (it, true);
it->continuation_lines_width = 0;
break;
case MOVE_LINE_TRUNCATED:
max_current_x = it->last_visible_x;
it->continuation_lines_width = 0;
- reseat_at_next_visible_line_start (it, 0);
+ reseat_at_next_visible_line_start (it, false);
if ((op & MOVE_TO_POS) != 0
&& IT_CHARPOS (*it) > to_charpos)
{
+= it->tab_width * face_font->space_width;
}
}
- set_iterator_to_next (it, 0);
+ set_iterator_to_next (it, false);
}
}
else
}
if (backup_data)
- bidi_unshelve_cache (backup_data, 1);
+ bidi_unshelve_cache (backup_data, true);
TRACE_MOVE ((stderr, "move_it_to: reached %d\n", reached));
reseat to skip forward over invisible text, set up the iterator
to deliver from overlay strings at the new position etc. So,
use reseat_1 here. */
- reseat_1 (it, it->current.pos, 1);
+ reseat_1 (it, it->current.pos, true);
/* We are now surely at a line start. */
it->current_x = it->hpos = 0; /* FIXME: this is incorrect when bidi
cp = find_newline_no_quit (cp, bp, -1, NULL);
move_it_to (it, cp, -1, -1, -1, MOVE_TO_POS);
}
- bidi_unshelve_cache (it3data, 1);
+ bidi_unshelve_cache (it3data, true);
}
else
{
rc = move_it_in_display_line_to (it, Z, 0, MOVE_TO_POS);
if (rc == MOVE_NEWLINE_OR_CR)
- set_iterator_to_next (it, 0);
+ set_iterator_to_next (it, false);
}
pos = *vmotion (IT_CHARPOS (*it), dvpos, it->w);
SET_TEXT_POS (textpos, pos.bufpos, pos.bytepos);
- reseat (it, textpos, 1);
+ reseat (it, textpos, true);
it->vpos += pos.vpos;
it->current_y += pos.vpos;
}
back_to_previous_visible_line_start (it);
if (i > 0 && IT_CHARPOS (*it) <= pos_limit)
hit_pos_limit = true;
- reseat (it, it->current.pos, 1);
+ reseat (it, it->current.pos, true);
/* Move further back if we end up in a string or an image. */
while (!IT_POS_VALID_AFTER_MOVE_P (it))
/* If start of line is still in string or image,
move further back. */
back_to_previous_visible_line_start (it);
- reseat (it, it->current.pos, 1);
+ reseat (it, it->current.pos, true);
dvpos--;
}
if (IT_CHARPOS (*it) >= start_charpos)
RESTORE_IT (it, &it2, it2data);
else
- bidi_unshelve_cache (it2data, 1);
+ bidi_unshelve_cache (it2data, true);
}
else if (hit_pos_limit && pos_limit > BEGV
&& dvpos < 0 && it2.vpos < -dvpos)
back_to_previous_visible_line_start (it);
it->vpos--;
}
- reseat_1 (it, it->current.pos, 1);
+ reseat_1 (it, it->current.pos, true);
}
else
RESTORE_IT (it, it, it2data);
value. If it is either the symbol `mode-line' or `header-line', include
only the height of that line, if present, in the return value. If t,
include the height of both, if present, in the return value. */)
- (Lisp_Object window, Lisp_Object from, Lisp_Object to, Lisp_Object x_limit, Lisp_Object y_limit,
- Lisp_Object mode_and_header_line)
+ (Lisp_Object window, Lisp_Object from, Lisp_Object to, Lisp_Object x_limit,
+ Lisp_Object y_limit, Lisp_Object mode_and_header_line)
{
struct window *w = decode_live_window (window);
- Lisp_Object buf;
+ Lisp_Object buffer = w->contents;
struct buffer *b;
struct it it;
- struct buffer *old_buffer = NULL;
+ struct buffer *old_b = NULL;
ptrdiff_t start, end, pos;
struct text_pos startp;
void *itdata = NULL;
int c, max_y = -1, x = 0, y = 0;
- buf = w->contents;
- CHECK_BUFFER (buf);
- b = XBUFFER (buf);
+ CHECK_BUFFER (buffer);
+ b = XBUFFER (buffer);
if (b != current_buffer)
{
- old_buffer = current_buffer;
+ old_b = current_buffer;
set_buffer_internal (b);
}
start_display. */
y = y + WINDOW_MODE_LINE_HEIGHT (w);
- bidi_unshelve_cache (itdata, 0);
+ bidi_unshelve_cache (itdata, false);
- if (old_buffer)
- set_buffer_internal (old_buffer);
+ if (old_b)
+ set_buffer_internal (old_b);
return Fcons (make_number (x), make_number (y));
}
buffer = SAFE_ALLOCA (len);
memcpy (buffer, SDATA (msg), len);
- message_dolog (buffer, len - 1, 1, 0);
+ message_dolog (buffer, len - 1, true, false);
SAFE_FREE ();
UNGCPRO;
message_log_maybe_newline (void)
{
if (message_log_need_newline)
- message_dolog ("", 0, 1, 0);
+ message_dolog ("", 0, true, false);
}
/* Ensure the Messages buffer exists, and switch to it.
If we created it, set the major-mode. */
- {
- int newbuffer = 0;
- if (NILP (Fget_buffer (Vmessages_buffer_name))) newbuffer = 1;
-
- Fset_buffer (Fget_buffer_create (Vmessages_buffer_name));
-
- if (newbuffer
- && !NILP (Ffboundp (intern ("messages-buffer-mode"))))
- call0 (intern ("messages-buffer-mode"));
- }
+ bool newbuffer = NILP (Fget_buffer (Vmessages_buffer_name));
+ Fset_buffer (Fget_buffer_create (Vmessages_buffer_name));
+ if (newbuffer
+ && !NILP (Ffboundp (intern ("messages-buffer-mode"))))
+ call0 (intern ("messages-buffer-mode"));
bset_undo_list (current_buffer, Qt);
bset_cache_long_scans (current_buffer, Qnil);
{
c = string_char_and_length (msg + i, &char_bytes);
work[0] = CHAR_TO_BYTE8 (c);
- insert_1_both (work, 1, 1, 1, 0, 0);
+ insert_1_both (work, 1, 1, true, false, false);
}
}
else if (! multibyte
c = msg[i];
MAKE_CHAR_MULTIBYTE (c);
char_bytes = CHAR_STRING (c, str);
- insert_1_both ((char *) str, 1, char_bytes, 1, 0, 0);
+ insert_1_both ((char *) str, 1, char_bytes, true, false, false);
}
}
else if (nbytes)
- insert_1_both (m, chars_in_text (msg, nbytes), nbytes, 1, 0, 0);
+ insert_1_both (m, chars_in_text (msg, nbytes), nbytes,
+ true, false, false);
if (nlflag)
{
ptrdiff_t this_bol, this_bol_byte, prev_bol, prev_bol_byte;
printmax_t dups;
- insert_1_both ("\n", 1, 1, 1, 0, 0);
+ insert_1_both ("\n", 1, 1, true, false, false);
- scan_newline (Z, Z_BYTE, BEG, BEG_BYTE, -2, 0);
+ scan_newline (Z, Z_BYTE, BEG, BEG_BYTE, -2, false);
this_bol = PT;
this_bol_byte = PT_BYTE;
If so, combine duplicates. */
if (this_bol > BEG)
{
- scan_newline (PT, PT_BYTE, BEG, BEG_BYTE, -2, 0);
+ scan_newline (PT, PT_BYTE, BEG, BEG_BYTE, -2, false);
prev_bol = PT;
prev_bol_byte = PT_BYTE;
if (dups)
{
del_range_both (prev_bol, prev_bol_byte,
- this_bol, this_bol_byte, 0);
+ this_bol, this_bol_byte, false);
if (dups > 1)
{
char dupstr[sizeof " [ times]"
change message_log_check_duplicate. */
int duplen = sprintf (dupstr, " [%"pMd" times]", dups);
TEMP_SET_PT_BOTH (Z - 1, Z_BYTE - 1);
- insert_1_both (dupstr, duplen, duplen, 1, 0, 1);
+ insert_1_both (dupstr, duplen, duplen,
+ true, false, true);
}
}
}
if (NATNUMP (Vmessage_log_max))
{
scan_newline (Z, Z_BYTE, BEG, BEG_BYTE,
- -XFASTINT (Vmessage_log_max) - 1, 0);
- del_range_both (BEG, BEG_BYTE, PT, PT_BYTE, 0);
+ -XFASTINT (Vmessage_log_max) - 1, false);
+ del_range_both (BEG, BEG_BYTE, PT, PT_BYTE, false);
}
}
BEGV = marker_position (oldbegv);
unchain_marker (XMARKER (oldzv));
/* We called insert_1_both above with its 5th argument (PREPARE)
- zero, which prevents insert_1_both from calling
+ false, which prevents insert_1_both from calling
prepare_to_modify_buffer, which in turns prevents us from
incrementing windows_or_buffers_changed even if *Messages* is
shown in some window. So we must manually set
{
ptrdiff_t i;
ptrdiff_t len = Z_BYTE - 1 - this_bol_byte;
- int seen_dots = 0;
+ bool seen_dots = false;
unsigned char *p1 = BUF_BYTE_ADDRESS (current_buffer, prev_bol_byte);
unsigned char *p2 = BUF_BYTE_ADDRESS (current_buffer, this_bol_byte);
for (i = 0; i < len; i++)
{
if (i >= 3 && p1[i - 3] == '.' && p1[i - 2] == '.' && p1[i - 1] == '.')
- seen_dots = 1;
+ seen_dots = true;
if (p1[i] != p2[i])
return seen_dots;
}
char *buffer;
USE_SAFE_ALLOCA;
SAFE_ALLOCA_STRING (buffer, m);
- message_dolog (buffer, nbytes, 1, multibyte);
+ message_dolog (buffer, nbytes, true, multibyte);
SAFE_FREE ();
}
message3_nolog (m);
{
if (noninteractive_need_newline)
putc ('\n', stderr);
- noninteractive_need_newline = 0;
+ noninteractive_need_newline = false;
if (STRINGP (m))
{
Lisp_Object s = ENCODE_SYSTEM (m);
fwrite (SDATA (s), SBYTES (s), 1, stderr);
}
- if (cursor_in_echo_area == 0)
+ if (!cursor_in_echo_area)
fprintf (stderr, "\n");
fflush (stderr);
}
which gets replaced with STRING. */
void
-message_with_string (const char *m, Lisp_Object string, int log)
+message_with_string (const char *m, Lisp_Object string, bool log)
{
CHECK_STRING (string);
if (noninteractive_need_newline)
putc ('\n', stderr);
- noninteractive_need_newline = 0;
+ noninteractive_need_newline = false;
fprintf (stderr, m, SDATA (ENCODE_SYSTEM (string)));
if (!cursor_in_echo_area)
fprintf (stderr, "\n");
/* Print should start at the beginning of the message
buffer next time. */
- message_buf_print = 0;
+ message_buf_print = false;
}
}
}
/* Dump an informative message to the minibuf. If M is 0, clear out
any existing message, and let the mini-buffer text show through. */
-static void
+static void ATTRIBUTE_FORMAT_PRINTF (1, 0)
vmessage (const char *m, va_list ap)
{
if (noninteractive)
{
if (noninteractive_need_newline)
putc ('\n', stderr);
- noninteractive_need_newline = 0;
+ noninteractive_need_newline = false;
vfprintf (stderr, m, ap);
- if (cursor_in_echo_area == 0)
+ if (!cursor_in_echo_area)
fprintf (stderr, "\n");
fflush (stderr);
}
/* Print should start at the beginning of the message
buffer next time. */
- message_buf_print = 0;
+ message_buf_print = false;
}
}
}
}
-#if 0
+#if false
/* The non-logging version of message. */
void
Value is what FN returns. */
-static int
+static bool
with_echo_area_buffer (struct window *w, int which,
- int (*fn) (ptrdiff_t, Lisp_Object),
+ bool (*fn) (ptrdiff_t, Lisp_Object),
ptrdiff_t a1, Lisp_Object a2)
{
Lisp_Object buffer;
- int this_one, the_other, clear_buffer_p, rc;
+ bool this_one, the_other, clear_buffer_p, rc;
ptrdiff_t count = SPECPDL_INDEX ();
/* If buffers aren't live, make new ones. */
ensure_echo_area_buffers ();
- clear_buffer_p = 0;
+ clear_buffer_p = false;
if (which == 0)
- this_one = 0, the_other = 1;
+ this_one = false, the_other = true;
else if (which > 0)
- this_one = 1, the_other = 0;
+ this_one = true, the_other = false;
else
{
- this_one = 0, the_other = 1;
+ this_one = false, the_other = true;
clear_buffer_p = true;
/* We need a fresh one in case the current echo buffer equals
/* Set up the echo area for use by print functions. MULTIBYTE_P
- non-zero means we will print multibyte. */
+ means we will print multibyte. */
void
-setup_echo_area_for_printing (int multibyte_p)
+setup_echo_area_for_printing (bool multibyte_p)
{
/* If we can't find an echo area any more, exit. */
if (! FRAME_LIVE_P (XFRAME (selected_frame)))
}
message_log_maybe_newline ();
- message_buf_print = 1;
+ message_buf_print = true;
}
else
{
}
-/* Display an echo area message in window W. Value is non-zero if W's
- height is changed. If display_last_displayed_message_p is
- non-zero, display the message that was last displayed, otherwise
+/* Display an echo area message in window W. Value is true if W's
+ height is changed. If display_last_displayed_message_p,
+ display the message that was last displayed, otherwise
display the current message. */
-static int
+static bool
display_echo_area (struct window *w)
{
- int i, no_message_p, window_height_changed_p;
+ bool 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.
nevertheless because it resizes the window. But we will have to
reset the echo_area_buffer in question to nil at the end because
with_echo_area_buffer will sets it to an empty buffer. */
- i = display_last_displayed_message_p ? 1 : 0;
+ bool i = display_last_displayed_message_p;
no_message_p = NILP (echo_area_buffer[i]);
window_height_changed_p
contains the current echo area message in window W, a mini-window,
a pointer to which is passed in A1. A2..A4 are currently not used.
Change the height of W so that all of the message is displayed.
- Value is non-zero if height of W was changed. */
+ Value is true if height of W was changed. */
-static int
+static bool
display_echo_area_1 (ptrdiff_t a1, Lisp_Object a2)
{
intptr_t i1 = a1;
struct window *w = (struct window *) i1;
Lisp_Object window;
struct text_pos start;
- int window_height_changed_p = 0;
/* Do this before displaying, so that we have a large enough glyph
matrix for the display. If we can't get enough space for the
whole text, display the last N lines. That works by setting w->start. */
- window_height_changed_p = resize_mini_window (w, 0);
+ bool window_height_changed_p = resize_mini_window (w, false);
/* Use the starting position chosen by resize_mini_window. */
SET_TEXT_POS_FROM_MARKER (start, w->start);
{
struct window *w = XWINDOW (echo_area_window);
Lisp_Object resize_exactly = (minibuf_level == 0 ? Qt : Qnil);
- int resized_p = with_echo_area_buffer (w, 0, resize_mini_window_1,
- (intptr_t) w, resize_exactly);
+ bool resized_p = with_echo_area_buffer (w, 0, resize_mini_window_1,
+ (intptr_t) w, resize_exactly);
if (resized_p)
{
windows_or_buffers_changed = 42;
size of the text displayed. A3 and A4 are not used. Value is what
resize_mini_window returns. */
-static int
+static bool
resize_mini_window_1 (ptrdiff_t a1, Lisp_Object exactly)
{
intptr_t i1 = a1;
to make the end of the contents appear. This is particularly
important for y-or-n-p, but seems desirable generally.
- Value is non-zero if the window height has been changed. */
+ Value is true if the window height has been changed. */
-int
-resize_mini_window (struct window *w, int exact_p)
+bool
+resize_mini_window (struct window *w, bool exact_p)
{
struct frame *f = XFRAME (w->frame);
- int window_height_changed_p = 0;
+ bool window_height_changed_p = false;
eassert (MINI_WINDOW_P (w));
we are running fontification-functions. We're running these
functions with safe_call which binds inhibit-redisplay to t. */
if (!NILP (Vinhibit_redisplay))
- return 0;
+ return false;
/* Nil means don't try to resize. */
if (NILP (Vresize_mini_windows)
|| (FRAME_X_P (f) && FRAME_X_OUTPUT (f) == NULL))
- return 0;
+ return false;
if (!FRAME_MINIBUF_ONLY_P (f))
{
{
int old_height = WINDOW_PIXEL_HEIGHT (w);
- FRAME_WINDOWS_FROZEN (f) = 1;
- grow_mini_window (w, height - WINDOW_PIXEL_HEIGHT (w), 1);
+ FRAME_WINDOWS_FROZEN (f) = true;
+ grow_mini_window (w, height - WINDOW_PIXEL_HEIGHT (w), true);
window_height_changed_p = WINDOW_PIXEL_HEIGHT (w) != old_height;
}
else if (height < WINDOW_PIXEL_HEIGHT (w)
{
int old_height = WINDOW_PIXEL_HEIGHT (w);
- FRAME_WINDOWS_FROZEN (f) = 0;
- shrink_mini_window (w, 1);
+ FRAME_WINDOWS_FROZEN (f) = false;
+ shrink_mini_window (w, true);
window_height_changed_p = WINDOW_PIXEL_HEIGHT (w) != old_height;
}
}
{
int old_height = WINDOW_PIXEL_HEIGHT (w);
- FRAME_WINDOWS_FROZEN (f) = 1;
- grow_mini_window (w, height - WINDOW_PIXEL_HEIGHT (w), 1);
+ FRAME_WINDOWS_FROZEN (f) = true;
+ grow_mini_window (w, height - WINDOW_PIXEL_HEIGHT (w), true);
window_height_changed_p = WINDOW_PIXEL_HEIGHT (w) != old_height;
}
else if (height < WINDOW_PIXEL_HEIGHT (w))
{
int old_height = WINDOW_PIXEL_HEIGHT (w);
- FRAME_WINDOWS_FROZEN (f) = 0;
- shrink_mini_window (w, 1);
+ FRAME_WINDOWS_FROZEN (f) = false;
+ shrink_mini_window (w, true);
if (height)
{
- FRAME_WINDOWS_FROZEN (f) = 1;
- grow_mini_window (w, height - WINDOW_PIXEL_HEIGHT (w), 1);
+ FRAME_WINDOWS_FROZEN (f) = true;
+ grow_mini_window (w, height - WINDOW_PIXEL_HEIGHT (w), true);
}
window_height_changed_p = WINDOW_PIXEL_HEIGHT (w) != old_height;
}
-static int
+static bool
current_message_1 (ptrdiff_t a1, Lisp_Object a2)
{
intptr_t i1 = a1;
Lisp_Object *msg = (Lisp_Object *) i1;
if (Z > BEG)
- *msg = make_buffer_string (BEG, Z, 1);
+ *msg = make_buffer_string (BEG, Z, true);
else
*msg = Qnil;
- return 0;
+ return false;
}
/* Push the current message on Vmessage_stack for later restoration
- by restore_message. Value is non-zero if the current message isn't
+ by restore_message. Value is true if the current message isn't
empty. This is a relatively infrequent operation, so it's not
worth optimizing. */
/* Helper function for truncate_echo_area. Truncate the current
message to at most NCHARS characters. */
-static int
+static bool
truncate_message_1 (ptrdiff_t nchars, Lisp_Object a2)
{
if (BEG + nchars < Z)
del_range (BEG + nchars, Z);
if (Z == BEG)
echo_area_buffer[0] = Qnil;
- return 0;
+ return false;
}
/* Set the current message to STRING. */
message_enable_multibyte = STRING_MULTIBYTE (string);
with_echo_area_buffer (0, -1, set_message_1, 0, string);
- message_buf_print = 0;
- help_echo_showing_p = 0;
+ message_buf_print = false;
+ help_echo_showing_p = false;
if (STRINGP (Vdebug_on_message)
&& STRINGP (string)
argument has the same meaning as for set_message.
This function is called with the echo area buffer being current. */
-static int
+static bool
set_message_1 (ptrdiff_t a1, Lisp_Object string)
{
eassert (STRINGP (string));
/* This function takes care of single/multibyte conversion.
We just have to ensure that the echo area buffer has the right
setting of enable_multibyte_characters. */
- insert_from_string (string, 0, 0, SCHARS (string), SBYTES (string), 1);
+ insert_from_string (string, 0, 0, SCHARS (string), SBYTES (string), true);
- return 0;
+ return false;
}
-/* Clear messages. CURRENT_P non-zero means clear the current
- message. LAST_DISPLAYED_P non-zero means clear the message
- last displayed. */
+/* Clear messages. CURRENT_P means clear the current message.
+ LAST_DISPLAYED_P means clear the message last displayed. */
void
clear_message (bool current_p, bool last_displayed_p)
if (last_displayed_p)
echo_area_buffer[1] = Qnil;
- message_buf_print = 0;
+ message_buf_print = false;
}
/* Clear garbaged frames.
}
-/* Redisplay the echo area of the selected frame. If UPDATE_FRAME_P
- is non-zero update selected_frame. Value is non-zero if the
- mini-windows height has been changed. */
+/* Redisplay the echo area of the selected frame. If UPDATE_FRAME_P,
+ update selected_frame. Value is true if the mini-windows height
+ has been changed. */
static bool
echo_area_display (bool update_frame_p)
/* Don't display if frame is invisible or not yet initialized. */
if (!FRAME_VISIBLE_P (f) || !f->glyphs_initialized_p)
- return 0;
+ return false;
#ifdef HAVE_WINDOW_SYSTEM
/* When Emacs starts, selected_frame may be the initial terminal
frame. If we let this through, a message would be displayed on
the terminal. */
if (FRAME_INITIAL_P (XFRAME (selected_frame)))
- return 0;
+ return false;
#endif /* HAVE_WINDOW_SYSTEM */
/* Redraw garbaged frames. */
return window_height_changed_p;
}
-/* Nonzero if W's buffer was changed but not saved. */
+/* True if W's buffer was changed but not saved. */
-static int
+static bool
window_buffer_changed (struct window *w)
{
struct buffer *b = XBUFFER (w->contents);
eassert (BUFFER_LIVE_P (b));
- return (((BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) != w->last_had_star));
+ return (BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) != w->last_had_star;
}
-/* Nonzero if W has %c in its mode line and mode line should be updated. */
+/* True if W has %c in its mode line and mode line should be updated. */
-static int
+static bool
mode_line_update_needed (struct window *w)
{
return (w->column_number_displayed != -1
&& (w->column_number_displayed != current_column ()));
}
-/* Nonzero if window start of W is frozen and may not be changed during
+/* True if window start of W is frozen and may not be changed during
redisplay. */
static bool
XSETWINDOW (window, w);
if (MINI_WINDOW_P (w))
- return 0;
+ return false;
else if (EQ (window, selected_window))
- return 0;
+ return false;
else if (MINI_WINDOW_P (XWINDOW (selected_window))
&& EQ (window, Vminibuf_scroll_window))
/* This special window can't be frozen too. */
- return 0;
+ return false;
else
- return 1;
+ return true;
}
- return 0;
+ return false;
}
/***********************************************************************
format_mode_line_unwind_data (struct frame *target_frame,
struct buffer *obuf,
Lisp_Object owin,
- int save_proptrans)
+ bool save_proptrans)
{
Lisp_Object vector, tmp;
mode_line_noprop_buf; then display the title. */
record_unwind_protect (unwind_format_mode_line,
format_mode_line_unwind_data
- (f, current_buffer, selected_window, 0));
+ (f, current_buffer, selected_window, false));
Fselect_window (f->selected_window, Qt);
set_buffer_internal_1
title_start = MODE_LINE_NOPROP_LEN (0);
init_iterator (&it, XWINDOW (f->selected_window), -1, -1,
NULL, DEFAULT_FACE_ID);
- display_mode_element (&it, 0, -1, -1, fmt, Qnil, 0);
+ display_mode_element (&it, 0, -1, -1, fmt, Qnil, false);
len = MODE_LINE_NOPROP_LEN (title_start);
title = mode_line_noprop_buf + title_start;
unbind_to (count, Qnil);
Menu Bars
***********************************************************************/
-/* Non-zero if we will not redisplay all visible windows. */
+/* True if we will not redisplay all visible windows. */
#define REDISPLAY_SOME_P() \
((windows_or_buffers_changed == 0 \
|| windows_or_buffers_changed == REDISPLAY_SOME) \
{
Lisp_Object tail, frame;
ptrdiff_t count = SPECPDL_INDEX ();
- /* 1 means that update_menu_bar has run its hooks
+ /* True 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;
+ bool menu_bar_hooks_run = false;
record_unwind_save_match_data ();
Lisp_Object functions;
/* Clear flag first in case we get an error below. */
- FRAME_WINDOW_SIZES_CHANGED (f) = 0;
+ FRAME_WINDOW_SIZES_CHANGED (f) = false;
functions = Vwindow_size_change_functions;
GCPRO2 (tail, functions);
}
GCPRO1 (tail);
- menu_bar_hooks_run = update_menu_bar (f, 0, menu_bar_hooks_run);
+ menu_bar_hooks_run = update_menu_bar (f, false, menu_bar_hooks_run);
#ifdef HAVE_WINDOW_SYSTEM
- update_tool_bar (f, 0);
+ update_tool_bar (f, false);
#endif
UNGCPRO;
}
else
{
struct frame *sf = SELECTED_FRAME ();
- update_menu_bar (sf, 1, 0);
+ update_menu_bar (sf, true, false);
#ifdef HAVE_WINDOW_SYSTEM
- update_tool_bar (sf, 1);
+ update_tool_bar (sf, true);
#endif
}
}
before we start to fill in any display lines, because it can call
eval.
- If SAVE_MATCH_DATA is non-zero, we must save and restore it here.
+ If SAVE_MATCH_DATA, we must save and restore it here.
- If HOOKS_RUN is 1, that means a previous call to update_menu_bar
+ If HOOKS_RUN, a previous call to update_menu_bar
already ran the menu bar hooks for this redisplay, so there
is no need to run them again. The return value is the
updated value of this flag, to pass to the next call. */
-static int
-update_menu_bar (struct frame *f, int save_match_data, int hooks_run)
+static bool
+update_menu_bar (struct frame *f, bool save_match_data, bool hooks_run)
{
Lisp_Object window;
- register struct window *w;
+ struct window *w;
/* If called recursively during a menu update, do nothing. This can
happen when, for instance, an activate-menubar-hook causes a
safe_run_hooks (Qmenu_bar_update_hook);
- hooks_run = 1;
+ hooks_run = true;
}
XSETFRAME (Vmenu_updating_frame, f);
the selected frame should be allowed to set it. */
if (f == SELECTED_FRAME ())
#endif
- set_frame_menubar (f, 0, 0);
+ set_frame_menubar (f, false, false);
}
else
/* On a terminal screen, the menu bar is an ordinary screen
line, and this makes it get updated. */
- w->update_mode_line = 1;
+ w->update_mode_line = true;
#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 = 1;
+ w->update_mode_line = true;
#endif /* ! (USE_X_TOOLKIT || HAVE_NTGUI || HAVE_NS || USE_GTK) */
unbind_to (count, Qnil);
/* Update the tool-bar item list for frame F. This has to be done
before we start to fill in any display lines. Called from
- prepare_menu_bars. If SAVE_MATCH_DATA is non-zero, we must save
+ prepare_menu_bars. If SAVE_MATCH_DATA, we must save
and restore it here. */
static void
-update_tool_bar (struct frame *f, int save_match_data)
+update_tool_bar (struct frame *f, bool save_match_data)
{
#if defined (USE_GTK) || defined (HAVE_NS)
- int do_update = FRAME_EXTERNAL_TOOL_BAR (f);
+ bool do_update = FRAME_EXTERNAL_TOOL_BAR (f);
#else
- int do_update = (WINDOWP (f->tool_bar_window)
- && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window)) > 0);
+ bool do_update = (WINDOWP (f->tool_bar_window)
+ && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window)) > 0);
#endif
if (do_update)
block_input ();
fset_tool_bar_items (f, new_tool_bar);
f->n_tool_bar_items = new_n_tool_bar;
- w->update_mode_line = 1;
+ w->update_mode_line = true;
unblock_input ();
}
#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));
+ bool enabled_p = !NILP (PROP (TOOL_BAR_ITEM_ENABLED_P));
+ bool selected_p = !NILP (PROP (TOOL_BAR_ITEM_SELECTED_P));
int hmargin, vmargin, relief, idx, end;
/* If image is a vector, choose the image according to the
/* Note that this isn't made use of if the face hasn't a box,
so there's no need to check the face here. */
- it->start_of_box_run_p = 1;
+ it->start_of_box_run_p = true;
while (it->current_x < max_x)
{
if (ITERATOR_AT_END_OF_LINE_P (it))
break;
- set_iterator_to_next (it, 1);
+ set_iterator_to_next (it, true);
}
out:;
extend_face_to_end_of_line (it);
last = row->glyphs[TEXT_AREA] + row->used[TEXT_AREA] - 1;
- last->right_box_line_p = 1;
+ last->right_box_line_p = true;
if (last == row->glyphs[TEXT_AREA])
- last->left_box_line_p = 1;
+ last->left_box_line_p = true;
/* Make line the desired height and center it vertically. */
if ((height -= it->max_ascent + it->max_descent) > 0)
row->extra_line_spacing = 0;
}
- row->full_width_p = 1;
- row->continued_p = 0;
- row->truncated_on_left_p = 0;
- row->truncated_on_right_p = 0;
+ row->full_width_p = true;
+ row->continued_p = false;
+ row->truncated_on_left_p = false;
+ row->truncated_on_right_p = false;
it->current_x = it->hpos = 0;
it->current_y += row->height;
if (WINDOWP (f->tool_bar_window)
&& WINDOW_PIXEL_HEIGHT (XWINDOW (f->tool_bar_window)) > 0)
{
- update_tool_bar (f, 1);
+ update_tool_bar (f, true);
if (f->n_tool_bar_items)
{
build_desired_tool_bar_string (f);
- height = tool_bar_height (f, NULL, NILP (pixelwise) ? 0 : 1);
+ height = tool_bar_height (f, NULL, !NILP (pixelwise));
}
}
#endif
}
-/* Display the tool-bar of frame F. Value is non-zero if tool-bar's
+/* Display the tool-bar of frame F. Value is true if tool-bar's
height should be changed. */
-static int
+static bool
redisplay_tool_bar (struct frame *f)
{
#if defined (USE_GTK) || defined (HAVE_NS)
if (FRAME_EXTERNAL_TOOL_BAR (f))
update_frame_tool_bar (f);
- return 0;
+ return false;
#else /* !USE_GTK && !HAVE_NS */
if (!WINDOWP (f->tool_bar_window)
|| (w = XWINDOW (f->tool_bar_window),
WINDOW_TOTAL_LINES (w) == 0))
- return 0;
+ return false;
/* Set up an iterator for the tool-bar window. */
init_iterator (&it, w, -1, -1, w->desired_matrix->rows, TOOL_BAR_FACE_ID);
if (f->n_tool_bar_rows == 0)
{
- int new_height = tool_bar_height (f, &f->n_tool_bar_rows, 1);
+ int new_height = tool_bar_height (f, &f->n_tool_bar_rows, true);
if (new_height != WINDOW_PIXEL_HEIGHT (w))
{
frame_default_tool_bar_height = new_height;
/* Always do that now. */
clear_glyph_matrix (w->desired_matrix);
- f->fonts_changed = 1;
- return 1;
+ f->fonts_changed = true;
+ return true;
}
}
/* It doesn't make much sense to try scrolling in the tool-bar
window, so don't do it. */
- w->desired_matrix->no_scrolling_p = 1;
- w->must_be_updated_p = 1;
+ w->desired_matrix->no_scrolling_p = true;
+ w->must_be_updated_p = true;
if (!NILP (Vauto_resize_tool_bars))
{
- int change_height_p = 0;
+ bool change_height_p = true;
/* If we couldn't display everything, change the tool-bar's
height if there is room for more. */
if (IT_STRING_CHARPOS (it) < it.end_charpos)
- change_height_p = 1;
+ change_height_p = true;
/* We subtract 1 because display_tool_bar_line advances the
glyph_row pointer before returning to its caller. We want to
FRAME_LINE_HEIGHT, change the tool-bar's height. */
if (!MATRIX_ROW_DISPLAYS_TEXT_P (row)
&& row->height >= FRAME_LINE_HEIGHT (f))
- change_height_p = 1;
+ change_height_p = true;
/* If row displays tool-bar items, but is partially visible,
change the tool-bar's height. */
if (MATRIX_ROW_DISPLAYS_TEXT_P (row)
&& MATRIX_ROW_BOTTOM_Y (row) > it.last_visible_y)
- change_height_p = 1;
+ change_height_p = true;
/* Resize windows as needed by changing the `tool-bar-lines'
frame parameter. */
if (change_height_p)
{
int nrows;
- int new_height = tool_bar_height (f, &nrows, 1);
+ int new_height = tool_bar_height (f, &nrows, true);
change_height_p = ((EQ (Vauto_resize_tool_bars, Qgrow_only)
&& !f->minimize_tool_bar_window_p)
? (new_height > WINDOW_PIXEL_HEIGHT (w))
: (new_height != WINDOW_PIXEL_HEIGHT (w)));
- f->minimize_tool_bar_window_p = 0;
+ f->minimize_tool_bar_window_p = false;
if (change_height_p)
{
frame_default_tool_bar_height = new_height;
clear_glyph_matrix (w->desired_matrix);
f->n_tool_bar_rows = nrows;
- f->fonts_changed = 1;
+ f->fonts_changed = true;
- return 1;
+ return true;
}
}
}
- f->minimize_tool_bar_window_p = 0;
- return 0;
+ f->minimize_tool_bar_window_p = false;
+ return false;
#endif /* USE_GTK || HAVE_NS */
}
/* Get information about the tool-bar item which is displayed in GLYPH
on frame F. Return in *PROP_IDX the index where tool-bar item
- properties start in F->tool_bar_items. Value is zero if
+ properties start in F->tool_bar_items. Value is false if
GLYPH doesn't display a tool-bar item. */
-static int
+static bool
tool_bar_item_info (struct frame *f, struct glyph *glyph, int *prop_idx)
{
Lisp_Object prop;
- int success_p;
int charpos;
/* This function can be called asynchronously, which means we must
F->tool_bar_items. */
prop = Fget_text_property (make_number (charpos),
Qmenu_item, f->current_tool_bar_string);
- if (INTEGERP (prop))
- {
- *prop_idx = XINT (prop);
- success_p = 1;
- }
- else
- success_p = 0;
-
- return success_p;
+ if (! INTEGERP (prop))
+ return false;
+ *prop_idx = XINT (prop);
+ return true;
}
\f
/* EXPORT:
Handle mouse button event on the tool-bar of frame F, at
- frame-relative coordinates X/Y. DOWN_P is 1 for a button press,
- 0 for button release. MODIFIERS is event modifiers for button
+ frame-relative coordinates X/Y. DOWN_P is true for a button press,
+ false for button release. MODIFIERS is event modifiers for button
release. */
void
-handle_tool_bar_click (struct frame *f, int x, int y, int down_p,
+handle_tool_bar_click (struct frame *f, int x, int y, bool down_p,
int modifiers)
{
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
Lisp_Object enabled_p;
int prop_idx;
enum draw_glyphs_face draw = DRAW_IMAGE_RAISED;
- int mouse_down_p, rc;
+ bool mouse_down_p;
+ int rc;
/* Function note_mouse_highlight is called with negative X/Y
values when mouse moves outside of the frame. */
hlinfo->mouse_face_beg_col = hpos;
hlinfo->mouse_face_beg_row = vpos;
hlinfo->mouse_face_beg_x = x;
- hlinfo->mouse_face_past_end = 0;
+ hlinfo->mouse_face_past_end = false;
hlinfo->mouse_face_end_col = hpos + 1;
hlinfo->mouse_face_end_row = vpos;
Horizontal scrolling
************************************************************************/
-static int hscroll_window_tree (Lisp_Object);
-static int hscroll_windows (Lisp_Object);
-
/* For all leaf windows in the window tree rooted at WINDOW, set their
hscroll value so that PT is (i) visible in the window, and (ii) so
that it is not within a certain margin at the window's left and
- right border. Value is non-zero if any window's hscroll has been
+ right border. Value is true if any window's hscroll has been
changed. */
-static int
+static bool
hscroll_window_tree (Lisp_Object window)
{
- int hscrolled_p = 0;
- int hscroll_relative_p = FLOATP (Vhscroll_step);
+ bool hscrolled_p = false;
+ bool hscroll_relative_p = FLOATP (Vhscroll_step);
int hscroll_step_abs = 0;
double hscroll_step_rel = 0;
hscroll_step_rel = XFLOAT_DATA (Vhscroll_step);
if (hscroll_step_rel < 0)
{
- hscroll_relative_p = 0;
+ hscroll_relative_p = false;
hscroll_step_abs = 0;
}
}
int text_area_width;
struct glyph_row *cursor_row;
struct glyph_row *bottom_row;
- int row_r2l_p;
bottom_row = MATRIX_BOTTOM_TEXT_ROW (w->desired_matrix, w);
if (w->cursor.vpos < bottom_row - w->desired_matrix->rows)
else
cursor_row = bottom_row - 1;
}
- row_r2l_p = cursor_row->reversed_p;
+ bool row_r2l_p = cursor_row->reversed_p;
text_area_width = window_box_width (w, TEXT_AREA);
/* If the position of this window's point has explicitly
changed, no more suspend auto hscrolling. */
if (NILP (Fequal (Fwindow_point (window), Fwindow_old_point (window))))
- w->suspend_auto_hscroll = 0;
+ w->suspend_auto_hscroll = false;
/* Remember window point. */
Fset_marker (w->old_pointm,
w->contents);
if (!NILP (Fbuffer_local_value (Qauto_hscroll_mode, w->contents))
- && w->suspend_auto_hscroll == 0
+ && !w->suspend_auto_hscroll
/* In some pathological cases, like restoring a window
configuration into a frame that is much smaller than
the one from which the configuration was saved, we
redisplay. */
if (w->hscroll != hscroll)
{
- XBUFFER (w->contents)->prevent_redisplay_optimizations_p = 1;
+ struct buffer *b = XBUFFER (w->contents);
+ b->prevent_redisplay_optimizations_p = true;
w->hscroll = hscroll;
- hscrolled_p = 1;
+ hscrolled_p = true;
}
}
}
window = w->next;
}
- /* Value is non-zero if hscroll of any leaf window has been changed. */
+ /* Value is true if hscroll of any leaf window has been changed. */
return hscrolled_p;
}
/* Set hscroll so that cursor is visible and not inside horizontal
scroll margins for all windows in the tree rooted at WINDOW. See
- also hscroll_window_tree above. Value is non-zero if any window's
+ also hscroll_window_tree above. Value is true if any window's
hscroll has been changed. If it has, desired matrices on the frame
of WINDOW are cleared. */
-static int
+static bool
hscroll_windows (Lisp_Object window)
{
- int hscrolled_p = hscroll_window_tree (window);
+ bool hscrolled_p = hscroll_window_tree (window);
if (hscrolled_p)
clear_desired_matrices (XFRAME (WINDOW_FRAME (XWINDOW (window))));
return hscrolled_p;
Redisplay
************************************************************************/
-/* Variables holding some state of redisplay if GLYPH_DEBUG is defined
- to a non-zero value. This is sometimes handy to have in a debugger
- session. */
+/* Variables holding some state of redisplay if GLYPH_DEBUG is defined.
+ This is sometimes handy to have in a debugger session. */
#ifdef GLYPH_DEBUG
#endif /* GLYPH_DEBUG */
-/* Value is non-zero if all changes in window W, which displays
+/* Value is true if all changes in window W, which displays
current_buffer, are in the text between START and END. START is a
buffer position, END is given as a distance from Z. Used in
redisplay_internal for display optimization. */
-static int
+static bool
text_outside_line_unchanged_p (struct window *w,
ptrdiff_t start, ptrdiff_t end)
{
- int unchanged_p = 1;
+ bool unchanged_p = true;
/* If text or overlays have changed, see where. */
if (window_outdated (w))
{
/* Gap in the line? */
if (GPT < start || Z - GPT < end)
- unchanged_p = 0;
+ unchanged_p = false;
/* Changes start in front of the line, or end after it? */
if (unchanged_p
&& (BEG_UNCHANGED < start - 1
|| END_UNCHANGED < end))
- unchanged_p = 0;
+ unchanged_p = false;
/* If selective display, can't optimize if changes start at the
beginning of the line. */
&& INTEGERP (BVAR (current_buffer, selective_display))
&& XINT (BVAR (current_buffer, selective_display)) > 0
&& (BEG_UNCHANGED < start || GPT <= start))
- unchanged_p = 0;
+ unchanged_p = false;
/* If there are overlays at the start or end of the line, these
may have overlay strings with newlines in them. A change at
{
if (BEG + BEG_UNCHANGED == start
&& overlay_touches_p (start))
- unchanged_p = 0;
+ unchanged_p = false;
if (END_UNCHANGED == end
&& overlay_touches_p (Z - end))
- unchanged_p = 0;
+ unchanged_p = false;
}
/* Under bidi reordering, adding or deleting a character in the
lines to that, but for now just give up this optimization. */
if (!NILP (BVAR (XBUFFER (w->contents), bidi_display_reordering))
&& NILP (BVAR (XBUFFER (w->contents), bidi_paragraph_direction)))
- unchanged_p = 0;
+ unchanged_p = false;
}
return unchanged_p;
return Voverlay_arrow_string;
}
-/* Return 1 if there are any overlay-arrows in current_buffer. */
-static int
+/* Return true if there are any overlay-arrows in current_buffer. */
+static bool
overlay_arrow_in_current_buffer_p (void)
{
Lisp_Object vlist;
val = find_symbol_value (var);
if (MARKERP (val)
&& current_buffer == XMARKER (val)->buffer)
- return 1;
+ return true;
}
- return 0;
+ return false;
}
-/* Return 1 if any overlay_arrows have moved or overlay-arrow-string
+/* Return true if any overlay_arrows have moved or overlay-arrow-string
has changed. */
-static int
+static bool
overlay_arrows_changed_p (void)
{
Lisp_Object vlist;
Fget (var, Qlast_arrow_position))
|| ! (pstr = overlay_arrow_string_or_property (var),
EQ (pstr, Fget (var, Qlast_arrow_string))))
- return 1;
+ return true;
}
- return 0;
+ return false;
}
/* Mark overlay arrows to be updated on next redisplay. */
#ifdef HAVE_WINDOW_SYSTEM
if (val = Fget (var, Qoverlay_arrow_bitmap), SYMBOLP (val))
{
- int fringe_bitmap;
- if ((fringe_bitmap = lookup_fringe_bitmap (val)) != 0)
+ int fringe_bitmap = lookup_fringe_bitmap (val);
+ if (fringe_bitmap != 0)
return make_number (fringe_bitmap);
}
#endif
return Qnil;
}
-/* Return 1 if point moved out of or into a composition. Otherwise
- return 0. PREV_BUF and PREV_PT are the last point buffer and
+/* Return true if point moved out of or into a composition. Otherwise
+ return false. PREV_BUF and PREV_PT are the last point buffer and
position. BUF and PT are the current point buffer and position. */
-static int
+static bool
check_point_in_composition (struct buffer *prev_buf, ptrdiff_t prev_pt,
struct buffer *buf, ptrdiff_t pt)
{
{
if (prev_pt == pt)
/* Point didn't move. */
- return 0;
+ return false;
if (prev_pt > BUF_BEGV (buf) && prev_pt < BUF_ZV (buf)
&& find_composition (prev_pt, -1, &start, &end, &prop, buffer)
&& composition_valid_p (start, end, prop)
&& start < prev_pt && end > prev_pt)
- /* The last point was within the composition. Return 1 iff
+ /* The last point was within the composition. Return true iff
point moved out of the composition. */
return (pt <= start || pt >= end);
}
&& w->current_matrix->buffer == b
&& w->current_matrix->zv == BUF_ZV (b)
&& w->current_matrix->begv == BUF_BEGV (b))
- b->clip_changed = 0;
+ b->clip_changed = false;
/* If display wasn't paused, and W is not a tool bar window, see if
point has been moved into or out of a composition. In that case,
- we set b->clip_changed to 1 to force updating the screen. If
- b->clip_changed has already been set to 1, we can skip this
- check. */
+ set b->clip_changed to force updating the screen. If
+ b->clip_changed has already been set, skip this check. */
if (!b->clip_changed && w->window_end_valid)
{
ptrdiff_t pt = (w == XWINDOW (selected_window)
if ((w->current_matrix->buffer != b || pt != w->last_point)
&& check_point_in_composition (w->current_matrix->buffer,
w->last_point, b, pt))
- b->clip_changed = 1;
+ b->clip_changed = true;
}
}
#define STOP_POLLING \
do { if (! polling_stopped_here) stop_polling (); \
- polling_stopped_here = 1; } while (0)
+ polling_stopped_here = true; } while (false)
#define RESUME_POLLING \
do { if (polling_stopped_here) start_polling (); \
- polling_stopped_here = 0; } while (0)
+ polling_stopped_here = false; } while (false)
/* Perhaps in the future avoid recentering windows if it
struct window *sw;
struct frame *fr;
bool pending;
- bool must_finish = 0, match_p;
+ bool must_finish = false, match_p;
struct text_pos tlbufpos, tlendpos;
int number_of_visible_frames;
ptrdiff_t count;
struct frame *sf;
- int polling_stopped_here = 0;
+ bool polling_stopped_here = false;
Lisp_Object tail, frame;
/* True means redisplay has to consider all windows on all
when we leave this function. */
count = SPECPDL_INDEX ();
record_unwind_protect_void (unwind_redisplay);
- redisplaying_p = 1;
+ redisplaying_p = true;
specbind (Qinhibit_free_realized_faces, Qnil);
/* Record this function, so it appears on the profiler's backtraces. */
record_in_backtrace (Qredisplay_internal, 0, 0);
FOR_EACH_FRAME (tail, frame)
- XFRAME (frame)->already_hscrolled_p = 0;
+ XFRAME (frame)->already_hscrolled_p = false;
retry:
/* Remember the currently selected window. */
if (f->fonts_changed)
{
adjust_frame_glyphs (f);
- f->fonts_changed = 0;
+ f->fonts_changed = false;
}
/* If cursor type has been changed on the frame
other than selected, consider all frames. */
{
/* Detect case that we need to write or remove a star in the mode line. */
if ((SAVE_MODIFF < MODIFF) != w->last_had_star)
- w->update_mode_line = 1;
+ w->update_mode_line = true;
if (mode_line_update_needed (w))
- w->update_mode_line = 1;
+ w->update_mode_line = true;
/* If reconsider_clip_changes above decided that the narrowing
in the current buffer changed, make sure all other windows
echo-area doesn't show through. */
&& !MINI_WINDOW_P (XWINDOW (selected_window))))
{
- int window_height_changed_p = echo_area_display (false);
+ bool window_height_changed_p = echo_area_display (false);
if (message_cleared_p)
update_miniwindow_p = true;
- must_finish = 1;
+ must_finish = true;
/* If we don't display the current message, don't clear the
message_cleared_p flag, because, if we did, we wouldn't clear
the echo area in the next redisplay which doesn't preserve
the echo area. */
if (!display_last_displayed_message_p)
- message_cleared_p = 0;
+ message_cleared_p = false;
if (window_height_changed_p)
{
}
else if (EQ (selected_window, minibuf_window)
&& (current_buffer->clip_changed || window_outdated (w))
- && resize_mini_window (w, 0))
+ && resize_mini_window (w, false))
{
/* Resized active mini-window to fit the size of what it is
showing if its contents might have changed. */
- must_finish = 1;
+ must_finish = true;
/* If window configuration was changed, frames may have been
marked garbaged. Clear them or we will experience
TRACE ((stderr, "trying display optimization 1\n"));
w->cursor.vpos = -1;
- overlay_arrow_seen = 0;
+ overlay_arrow_seen = false;
it.vpos = this_line_vpos;
it.current_y = this_line_y;
it.glyph_row = MATRIX_ROW (w->desired_matrix, this_line_vpos);
else if (w->window_end_vpos == this_line_vpos
&& this_line_vpos > 0)
w->window_end_vpos = this_line_vpos - 1;
- w->window_end_valid = 0;
+ w->window_end_valid = false;
/* Update hint: No need to try to scroll in update_window. */
- w->desired_matrix->no_scrolling_p = 1;
+ w->desired_matrix->no_scrolling_p = true;
#ifdef GLYPH_DEBUG
*w->desired_matrix->method = 0;
debug_method_add (w, "optimization 1");
#endif
#ifdef HAVE_WINDOW_SYSTEM
- update_window_fringes (w, 0);
+ update_window_fringes (w, false);
#endif
goto update;
}
#endif
/* Build desired matrices, and update the display. If
- consider_all_windows_p is non-zero, do it for all windows on all
- frames. Otherwise do it for selected_window, only. */
+ consider_all_windows_p, do it for all windows on all frames.
+ Otherwise do it for selected_window, only. */
if (consider_all_windows_p)
{
FOR_EACH_FRAME (tail, frame)
- XFRAME (frame)->updated_p = 0;
+ XFRAME (frame)->updated_p = false;
propagate_buffer_redisplay ();
if (f->updated_p)
{
f->redisplay = false;
- mark_window_display_accurate (f->root_window, 1);
+ mark_window_display_accurate (f->root_window, true);
if (FRAME_TERMINAL (f)->frame_up_to_date_hook)
FRAME_TERMINAL (f)->frame_up_to_date_hook (f);
}
/* This can happen if b->text->redisplay was set during
jit-lock. */
propagate_buffer_redisplay ();
- mark_window_display_accurate_1 (w, 1);
+ mark_window_display_accurate_1 (w, true);
/* Say overlay arrows are up to date. */
update_overlay_arrows (1);
static void
unwind_redisplay (void)
{
- redisplaying_p = 0;
+ redisplaying_p = false;
}
/* Mark the display of leaf window W as accurate or inaccurate.
- If ACCURATE_P is non-zero mark display of W as accurate. If
- ACCURATE_P is zero, arrange for W to be redisplayed the next
+ If ACCURATE_P, mark display of W as accurate.
+ If !ACCURATE_P, arrange for W to be redisplayed the next
time redisplay_internal is called. */
static void
-mark_window_display_accurate_1 (struct window *w, int accurate_p)
+mark_window_display_accurate_1 (struct window *w, bool accurate_p)
{
struct buffer *b = XBUFFER (w->contents);
/* Mark the display of windows in the window tree rooted at WINDOW as
- accurate or inaccurate. If ACCURATE_P is non-zero mark display of
- windows as accurate. If ACCURATE_P is zero, arrange for windows to
+ accurate or inaccurate. If ACCURATE_P, mark display of
+ windows as accurate. If !ACCURATE_P, arrange for windows to
be redisplayed the next time redisplay_internal is called. */
void
-mark_window_display_accurate (Lisp_Object window, int accurate_p)
+mark_window_display_accurate (Lisp_Object window, bool accurate_p)
{
struct window *w;
which positions recorded in ROW differ from current buffer
positions.
- Return 0 if cursor is not on this row, 1 otherwise. */
+ Return true iff cursor is on this row. */
-static int
+static bool
set_cursor_from_row (struct window *w, struct glyph_row *row,
struct glyph_matrix *matrix,
ptrdiff_t delta, ptrdiff_t delta_bytes,
/* A glyph beyond the edge of TEXT_AREA which we should never
touch. */
struct glyph *glyphs_end = end;
- /* Non-zero means we've found a match for cursor position, but that
+ /* True means we've found a match for cursor position, but that
glyph has the avoid_cursor_p flag set. */
- int match_with_avoid_cursor = 0;
- /* Non-zero means we've seen at least one glyph that came from a
+ bool match_with_avoid_cursor = false;
+ /* True means we've seen at least one glyph that came from a
display string. */
- int string_seen = 0;
+ bool string_seen = false;
/* Largest and smallest buffer positions seen so far during scan of
glyph row. */
ptrdiff_t bpos_max = pos_before;
/* Last buffer position covered by an overlay string with an integer
`cursor' property. */
ptrdiff_t bpos_covered = 0;
- /* Non-zero means the display string on which to display the cursor
+ /* True 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;
+ bool string_from_text_prop = false;
/* 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. */
eassert (!row->mode_line_p);
if (row->mode_line_p)
- return 0;
+ return false;
/* Skip over glyphs not having an object at the start and the end of
the row. These are special glyphs like truncation marks on
display the cursor. */
if (dpos == 0)
{
- match_with_avoid_cursor = 0;
+ match_with_avoid_cursor = false;
break;
}
/* See if we've found a better approximation to
}
}
else if (dpos == 0)
- match_with_avoid_cursor = 1;
+ match_with_avoid_cursor = true;
}
else if (STRINGP (glyph->object))
{
ever seen in the row. */
ptrdiff_t prop_pos =
string_buffer_position_lim (glyph->object, pos_before,
- pos_after, 0);
+ pos_after, false);
if (prop_pos >= pos_before)
bpos_max = prop_pos;
}
}
- string_seen = 1;
+ string_seen = true;
}
x += glyph->pixel_width;
++glyph;
{
if (dpos == 0)
{
- match_with_avoid_cursor = 0;
+ match_with_avoid_cursor = false;
break;
}
if (0 > dpos && dpos > pos_before - pt_old)
}
}
else if (dpos == 0)
- match_with_avoid_cursor = 1;
+ match_with_avoid_cursor = true;
}
else if (STRINGP (glyph->object))
{
{
ptrdiff_t prop_pos =
string_buffer_position_lim (glyph->object, pos_before,
- pos_after, 0);
+ pos_after, false);
if (prop_pos >= pos_before)
bpos_max = prop_pos;
break;
}
}
- string_seen = 1;
+ string_seen = true;
}
--glyph;
if (glyph == glyphs_end) /* don't dereference outside TEXT_AREA */
Note that on a TTY, there are more glyphs after that, which
were produced by extend_face_to_end_of_line, but their
CHARPOS is zero or negative. */
- int empty_line_p =
- (row->reversed_p ? glyph > glyphs_end : glyph < glyphs_end)
- && NILP (glyph->object) && glyph->charpos > 0
- /* On a TTY, continued and truncated rows also have a glyph at
- their end whose OBJECT is nil and whose CHARPOS is
- positive (the continuation and truncation glyphs), but such
- rows are obviously not "empty". */
- && !(row->continued_p || row->truncated_on_right_p);
+ bool empty_line_p =
+ ((row->reversed_p ? glyph > glyphs_end : glyph < glyphs_end)
+ && NILP (glyph->object) && glyph->charpos > 0
+ /* On a TTY, continued and truncated rows also have a glyph at
+ their end whose OBJECT is nil and whose CHARPOS is
+ positive (the continuation and truncation glyphs), but such
+ rows are obviously not "empty". */
+ && !(row->continued_p || row->truncated_on_right_p));
if (row->ends_in_ellipsis_p && pos_after == last_pos)
{
ptrdiff_t lim = pos_after
+ (pos_after == MATRIX_ROW_END_CHARPOS (row) + delta);
- string_from_text_prop = 0;
+ string_from_text_prop = false;
str = glyph->object;
- tem = string_buffer_position_lim (str, pos, lim, 0);
+ tem = string_buffer_position_lim (str, pos, lim, false);
if (tem == 0 /* from overlay */
|| pos <= tem)
{
if (tem)
{
cursor = glyph;
- string_from_text_prop = 1;
+ string_from_text_prop = true;
}
for ( ;
(row->reversed_p ? glyph > stop : glyph < stop)
&& (row->reversed_p ? end > glyphs_end : end < glyphs_end)
&& STRINGP (end->object)
&& row->continued_p)
- return 0;
+ return false;
}
/* A truncated row may not include PT among its character positions.
Setting the cursor inside the scroll margin will trigger
/* Don't consider glyphs that are outside TEXT_AREA. */
if (!(row->reversed_p ? glyph > glyphs_end : glyph < glyphs_end))
- return 0;
+ return false;
/* Keep the candidate whose buffer position is the closest to
point or has the `cursor' property. */
if (/* Previous candidate is a glyph in TEXT_AREA of that row. */
position is not an exact match */
|| (NILP (glyph->object)
&& glyph->charpos != pt_old)))))
- return 0;
+ return false;
/* If this candidate gives an exact match, use that. */
if (!((BUFFERP (glyph->object) && glyph->charpos == pt_old)
/* If this candidate is a glyph created for the
&& MATRIX_ROW_END_CHARPOS (MATRIX_ROW (matrix, w->cursor.vpos))
- MATRIX_ROW_START_CHARPOS (MATRIX_ROW (matrix, w->cursor.vpos))
< MATRIX_ROW_END_CHARPOS (row) - MATRIX_ROW_START_CHARPOS (row))
- return 0;
+ return false;
}
w->cursor.hpos = glyph - row->glyphs[TEXT_AREA];
w->cursor.x = x;
CHARPOS (this_line_start_pos) = 0;
}
- return 1;
+ return true;
}
/* Make sure the line containing the cursor is fully visible.
- A value of 1 means there is nothing to be done.
+ A value of true means there is nothing to be done.
(Either the line is fully visible, or it cannot be made so,
or we cannot tell.)
- If FORCE_P is non-zero, return 0 even if partial visible cursor row
+ If FORCE_P, return false even if partial visible cursor row
is higher than window.
- If CURRENT_MATRIX_P is non-zero, use the information from the
+ If CURRENT_MATRIX_P, use the information from the
window's current glyph matrix; otherwise use the desired glyph
matrix.
- A value of 0 means the caller should do scrolling
+ A value of false means the caller should do scrolling
as if point had gone off the screen. */
-static int
-cursor_row_fully_visible_p (struct window *w, int force_p, int current_matrix_p)
+static bool
+cursor_row_fully_visible_p (struct window *w, bool force_p,
+ bool current_matrix_p)
{
struct glyph_matrix *matrix;
struct glyph_row *row;
int window_height;
if (!make_cursor_line_fully_visible_p)
- return 1;
+ return true;
/* It's not always possible to find the cursor, e.g, when a window
is full of overlay strings. Don't do anything in that case. */
if (w->cursor.vpos < 0)
- return 1;
+ return true;
matrix = current_matrix_p ? w->current_matrix : w->desired_matrix;
row = MATRIX_ROW (matrix, w->cursor.vpos);
/* If the cursor row is not partially visible, there's nothing to do. */
if (!MATRIX_ROW_PARTIALLY_VISIBLE_P (w, row))
- return 1;
+ return true;
/* If the row the cursor is in is taller than the window's height,
it's not clear what to do, so do nothing. */
{
if (!force_p || MINI_WINDOW_P (w)
|| w->vscroll || w->cursor.vpos == 0)
- return 1;
+ return true;
}
- return 0;
+ return false;
}
/* Try scrolling PT into view in window WINDOW. JUST_THIS_ONE_P
- non-zero means only WINDOW is redisplayed in redisplay_internal.
+ means only WINDOW is redisplayed in redisplay_internal.
TEMP_SCROLL_STEP has the same meaning as emacs_scroll_step, and is used
in redisplay_window to bring a partially visible line into view in
the case that only the cursor has moved.
- LAST_LINE_MISFIT should be nonzero if we're scrolling because the
+ LAST_LINE_MISFIT should be true if we're scrolling because the
last screen line's vertical height extends past the end of the screen.
Value is
#define SCROLL_LIMIT 100
static int
-try_scrolling (Lisp_Object window, int just_this_one_p,
+try_scrolling (Lisp_Object window, bool just_this_one_p,
ptrdiff_t arg_scroll_conservatively, ptrdiff_t scroll_step,
- int temp_scroll_step, int last_line_misfit)
+ bool temp_scroll_step, bool last_line_misfit)
{
struct window *w = XWINDOW (window);
struct frame *f = XFRAME (w->frame);
struct text_pos pos, startp;
struct it it;
int this_scroll_margin, scroll_max, rc, height;
- int dy = 0, amount_to_scroll = 0, scroll_down_p = 0;
- int extra_scroll_margin_lines = last_line_misfit ? 1 : 0;
+ int dy = 0, amount_to_scroll = 0;
+ bool scroll_down_p = false;
+ int extra_scroll_margin_lines = last_line_misfit;
Lisp_Object aggressive;
/* We will never try scrolling more than this number of lines. */
int scroll_limit = SCROLL_LIMIT;
return SCROLLING_FAILED;
if (dy > 0)
- scroll_down_p = 1;
+ scroll_down_p = true;
}
}
/* If cursor ends up on a partially visible line,
treat that as being off the bottom of the screen. */
- if (! cursor_row_fully_visible_p (w, extra_scroll_margin_lines <= 1, 0)
+ if (! cursor_row_fully_visible_p (w, extra_scroll_margin_lines <= 1,
+ false)
/* It's possible that the cursor is on the first line of the
buffer, which is partially obscured due to a vscroll
(Bug#7537). In that case, avoid looping forever. */
/* Compute a suitable window start for window W if display of W starts
- on a continuation line. Value is non-zero if a new window start
+ on a continuation line. Value is true if a new window start
was computed.
The new window start will be computed, based on W's width, starting
from the start of the continued line. It is the start of the
screen line with the minimum distance from the old start W->start. */
-static int
+static bool
compute_window_start_on_continuation_line (struct window *w)
{
struct text_pos pos, start_pos;
- int window_start_changed_p = 0;
+ bool window_start_changed_p = false;
SET_TEXT_POS_FROM_MARKER (start_pos, w->start);
/* Find the start of the continued line. This should be fast
because find_newline is fast (newline cache). */
- row = w->desired_matrix->rows + (WINDOW_WANTS_HEADER_LINE_P (w) ? 1 : 0);
+ row = w->desired_matrix->rows + WINDOW_WANTS_HEADER_LINE_P (w);
init_iterator (&it, w, CHARPOS (start_pos), BYTEPOS (start_pos),
row, DEFAULT_FACE_ID);
reseat_at_previous_visible_line_start (&it);
/* Set the window start there. */
SET_MARKER_FROM_TEXT_POS (w->start, pos);
- window_start_changed_p = 1;
+ window_start_changed_p = true;
}
}
CURSOR_MOVEMENT_CANNOT_BE_USED if this method cannot be used
CURSOR_MOVEMENT_MUST_SCROLL if we know we have to scroll the
- display. *SCROLL_STEP is set to 1, under certain circumstances, if
+ display. *SCROLL_STEP is set to true, under certain circumstances, if
we want to scroll as if scroll-step were set to 1. See the code.
CURSOR_MOVEMENT_NEED_LARGER_MATRICES if we need larger matrices, in
};
static int
-try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_step)
+try_cursor_movement (Lisp_Object window, struct text_pos startp,
+ bool *scroll_step)
{
struct window *w = XWINDOW (window);
struct frame *f = XFRAME (w->frame);
if (rc == CURSOR_MOVEMENT_CANNOT_BE_USED)
{
- int scroll_p = 0, must_scroll = 0;
+ bool scroll_p = false, must_scroll = false;
int last_y = window_text_bottom_y (w) - this_scroll_margin;
if (PT > w->last_point)
&& PT == MATRIX_ROW_END_CHARPOS (row)
&& !row->ends_at_zv_p
&& !MATRIX_ROW_ENDS_IN_MIDDLE_OF_CHAR_P (row)))
- scroll_p = 1;
+ scroll_p = true;
}
else if (PT < w->last_point)
{
/* If within the scroll margin, scroll. */
if (row->y < top_scroll_margin
&& CHARPOS (startp) != BEGV)
- scroll_p = 1;
+ scroll_p = true;
}
else
{
{
/* if PT is not in the glyph row, give up. */
rc = CURSOR_MOVEMENT_MUST_SCROLL;
- must_scroll = 1;
+ must_scroll = true;
}
else if (rc != CURSOR_MOVEMENT_SUCCESS
&& !NILP (BVAR (XBUFFER (w->contents), bidi_display_reordering)))
else if (rc != CURSOR_MOVEMENT_SUCCESS
&& MATRIX_ROW_PARTIALLY_VISIBLE_P (w, row)
/* Make sure this isn't a header line by any chance, since
- then MATRIX_ROW_PARTIALLY_VISIBLE_P might yield non-zero. */
+ then MATRIX_ROW_PARTIALLY_VISIBLE_P might yield true. */
&& !row->mode_line_p
&& make_cursor_line_fully_visible_p)
{
make it fully visible, except when it's taller
than the window, in which case we can't do much
about it. */
- *scroll_step = 1;
+ *scroll_step = true;
rc = CURSOR_MOVEMENT_MUST_SCROLL;
}
else
{
set_cursor_from_row (w, row, w->current_matrix, 0, 0, 0, 0);
- if (!cursor_row_fully_visible_p (w, 0, 1))
+ if (!cursor_row_fully_visible_p (w, false, true))
rc = CURSOR_MOVEMENT_MUST_SCROLL;
else
rc = CURSOR_MOVEMENT_SUCCESS;
/* FIXME: Revisit this when glyph ``spilling'' in
continuation lines' rows is implemented for
bidi-reordered rows. */
- int rv = 0;
+ bool rv = false;
do
{
- int at_zv_p = 0, exact_match_p = 0;
+ bool at_zv_p = false, exact_match_p = false;
if (MATRIX_ROW_START_CHARPOS (row) <= PT
&& PT <= MATRIX_ROW_END_CHARPOS (row)
}
-/* Redisplay leaf window WINDOW. JUST_THIS_ONE_P non-zero means only
+/* Redisplay leaf window WINDOW. JUST_THIS_ONE_P means only
selected_window is redisplayed.
We can return without actually redisplaying the window if fonts has been
struct buffer *buffer = XBUFFER (w->contents);
struct buffer *old = current_buffer;
struct text_pos lpoint, opoint, startp;
- int update_mode_line;
+ bool update_mode_line;
int tem;
struct it it;
/* Record it now because it's overwritten. */
/* This is less strict than current_matrix_up_to_date_p.
It indicates that the buffer contents and narrowing are unchanged. */
bool buffer_unchanged_p = false;
- int temp_scroll_step = 0;
+ bool temp_scroll_step = false;
ptrdiff_t count = SPECPDL_INDEX ();
int rc;
int centering_position = -1;
- int last_line_misfit = 0;
+ bool last_line_misfit = false;
ptrdiff_t beg_unchanged, end_unchanged;
int frame_line_height;
if (!just_this_one_p
&& REDISPLAY_SOME_P ()
&& !w->redisplay
+ && !w->update_mode_line
&& !f->redisplay
&& !buffer->text->redisplay
&& BUF_PT (buffer) == w->last_point)
emacs_abort ();
if (mode_line_update_needed (w))
- update_mode_line = 1;
+ update_mode_line = true;
/* Point refers normally to the selected window. For any other
window, set up appropriate value. */
{
ptrdiff_t it_charpos;
- w->optional_new_start = 0;
+ w->optional_new_start = false;
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);
&& !w->force_start)
{
if (it_charpos == PT)
- w->force_start = 1;
+ w->force_start = true;
/* IT may overshoot PT if text at PT is invisible. */
else if (it_charpos > PT && CHARPOS (startp) <= PT)
- w->force_start = 1;
+ w->force_start = true;
#ifdef GLYPH_DEBUG
if (w->force_start)
{
/* We set this later on if we have to adjust point. */
int new_vpos = -1;
- w->force_start = 0;
+ w->force_start = false;
w->vscroll = 0;
- w->window_end_valid = 0;
+ w->window_end_valid = false;
/* Forget any recorded base line for line number display. */
if (!buffer_unchanged_p)
if (!update_mode_line
|| ! NILP (Vwindow_scroll_functions))
{
- update_mode_line = 1;
- w->update_mode_line = 1;
+ update_mode_line = true;
+ w->update_mode_line = true;
startp = run_window_scroll_functions (window, startp);
}
the scroll margin (bug#148) -- cyd */
if (!try_window (window, startp, 0))
{
- w->force_start = 1;
+ w->force_start = true;
clear_glyph_matrix (w->desired_matrix);
goto need_larger_matrices;
}
new_vpos = window_box_height (w) / 2;
}
- if (!cursor_row_fully_visible_p (w, 0, 0))
+ if (!cursor_row_fully_visible_p (w, false, false))
{
/* Point does appear, but on a line partly visible at end of window.
Move it back to a fully-visible line. */
goto need_larger_matrices;
}
}
- if (w->cursor.vpos < 0 || !cursor_row_fully_visible_p (w, 0, 0))
+ if (w->cursor.vpos < 0 || !cursor_row_fully_visible_p (w, false, false))
{
clear_glyph_matrix (w->desired_matrix);
goto try_to_scroll;
/* Handle case where text has not changed, only point, and it has
not moved off the frame, and we are not retrying after hscroll.
- (current_matrix_up_to_date_p is nonzero when retrying.) */
+ (current_matrix_up_to_date_p is true when retrying.) */
if (current_matrix_up_to_date_p
&& (rc = try_cursor_movement (window, startp, &temp_scroll_step),
rc != CURSOR_MOVEMENT_CANNOT_BE_USED))
switch (rc)
{
case CURSOR_MOVEMENT_SUCCESS:
- used_current_matrix_p = 1;
+ used_current_matrix_p = true;
goto done;
case CURSOR_MOVEMENT_MUST_SCROLL:
in which case we accept that it is partially visible. */
&& (rtop != 0) == (rbot != 0))
{
- w->force_start = 1;
+ w->force_start = true;
SET_TEXT_POS_FROM_MARKER (startp, w->start);
#ifdef GLYPH_DEBUG
debug_method_add (w, "recomputed window start in continuation line");
/* Forget any recorded base line for line number display. */
w->base_line_number = 0;
- if (!cursor_row_fully_visible_p (w, 1, 0))
+ if (!cursor_row_fully_visible_p (w, true, false))
{
clear_glyph_matrix (w->desired_matrix);
- last_line_misfit = 1;
+ last_line_misfit = true;
}
/* Drop through and scroll. */
else
/* Redisplay the mode line. Select the buffer properly for that. */
if (!update_mode_line)
{
- update_mode_line = 1;
- w->update_mode_line = 1;
+ update_mode_line = true;
+ w->update_mode_line = true;
}
/* Try to scroll by specified few lines. */
: 0;
ptrdiff_t margin_pos = CHARPOS (startp);
Lisp_Object aggressive;
- int scrolling_up;
+ bool scrolling_up;
/* If there is a scroll margin at the top of the window, find
its character position. */
if (pt_offset)
centering_position -= pt_offset;
centering_position -=
- frame_line_height * (1 + margin + (last_line_misfit != 0))
- + WINDOW_HEADER_LINE_HEIGHT (w);
+ (frame_line_height * (1 + margin + last_line_misfit)
+ + WINDOW_HEADER_LINE_HEIGHT (w));
/* Don't let point enter the scroll margin near top of
the window. */
if (centering_position < margin * frame_line_height)
get_char_property_and_overlay (make_number (PT), Qinvisible,
Qnil, NULL);
- if (TEXT_PROP_MEANS_INVISIBLE (val))
+ if (TEXT_PROP_MEANS_INVISIBLE (val) != 0)
{
ptrdiff_t alt_pos;
Lisp_Object invis_end =
set_cursor_from_row (w, row, w->current_matrix, 0, 0, 0, 0);
}
- if (!cursor_row_fully_visible_p (w, 0, 0))
+ if (!cursor_row_fully_visible_p (w, false, false))
{
/* If vscroll is enabled, disable it and try again. */
if (w->vscroll)
scroll_margin > 0
? min (scroll_margin, window_total_lines / 4)
: 0;
- int move_down = w->cursor.vpos >= window_total_lines / 2;
+ bool move_down = w->cursor.vpos >= window_total_lines / 2;
move_it_by_lines (&it, move_down ? margin + 1 : -(margin + 1));
clear_glyph_matrix (w->desired_matrix);
if (WINDOW_WANTS_MODELINE_P (w)
&& CURRENT_MODE_LINE_HEIGHT (w) != DESIRED_MODE_LINE_HEIGHT (w))
{
- f->fonts_changed = 1;
+ f->fonts_changed = true;
w->mode_line_height = -1;
MATRIX_MODE_LINE_ROW (w->current_matrix)->height
= DESIRED_MODE_LINE_HEIGHT (w);
if (WINDOW_WANTS_HEADER_LINE_P (w)
&& CURRENT_HEADER_LINE_HEIGHT (w) != DESIRED_HEADER_LINE_HEIGHT (w))
{
- f->fonts_changed = 1;
+ f->fonts_changed = true;
w->header_line_height = -1;
MATRIX_HEADER_LINE_ROW (w->current_matrix)->height
= DESIRED_HEADER_LINE_HEIGHT (w);
if (update_mode_line
&& EQ (FRAME_SELECTED_WINDOW (f), window))
{
- int redisplay_menu_p = 0;
+ bool redisplay_menu_p;
if (FRAME_WINDOW_P (f))
{
&& (FRAME_TOOL_BAR_LINES (f) > 0
|| !NILP (Vauto_resize_tool_bars))
&& redisplay_tool_bar (f))
- ignore_mouse_drag_p = 1;
+ ignore_mouse_drag_p = true;
#endif
}
#endif
{
update_begin (f);
block_input ();
- if (draw_window_fringes (w, 1))
+ if (draw_window_fringes (w, true))
{
if (WINDOW_RIGHT_DIVIDER_WIDTH (w))
x_draw_right_divider (w);
/* Mark cursor position as unknown. No overlay arrow seen. */
w->cursor.vpos = -1;
- overlay_arrow_seen = 0;
+ overlay_arrow_seen = false;
/* Initialize iterator and info to start at POS. */
start_display (&it, w, pos);
/* If bottom moved off end of frame, change mode line percentage. */
if (w->window_end_pos <= 0 && Z != IT_CHARPOS (it))
- w->update_mode_line = 1;
+ w->update_mode_line = true;
/* Set window_end_pos to the offset of the last character displayed
on the window from the end of current_buffer. Set
if (last_text_row)
{
eassert (MATRIX_ROW_DISPLAYS_TEXT_P (last_text_row));
- adjust_window_ends (w, last_text_row, 0);
+ adjust_window_ends (w, last_text_row, false);
eassert
(MATRIX_ROW_DISPLAYS_TEXT_P (MATRIX_ROW (w->desired_matrix,
w->window_end_vpos)));
}
/* But that is not valid info until redisplay finishes. */
- w->window_end_valid = 0;
+ w->window_end_valid = false;
return 1;
}
/* Try redisplay of window W showing an unchanged buffer with a
different window start than the last time it was displayed by
- reusing its current matrix. Value is non-zero if successful.
+ reusing its current matrix. Value is true if successful.
W->start is the new window start. */
-static int
+static bool
try_window_reusing_current_matrix (struct window *w)
{
struct frame *f = XFRAME (w->frame);
#ifdef GLYPH_DEBUG
if (inhibit_try_window_reusing)
- return 0;
-#endif
-
-#ifdef HAVE_XWIDGETS_xxx
- //currently this is needed to detect xwidget movement reliably. or probably not.
- printf("try_window_reusing_current_matrix\n");
- return 0;
+ return false;
#endif
-
if (/* This function doesn't handle terminal frames. */
!FRAME_WINDOW_P (f)
/* Don't try to reuse the display if windows have been split
or such. */
|| windows_or_buffers_changed
|| f->cursor_type_changed)
- return 0;
+ return false;
/* Can't do this if showing trailing whitespace. */
if (!NILP (Vshow_trailing_whitespace))
- return 0;
+ return false;
/* If top-line visibility has changed, give up. */
if (WINDOW_WANTS_HEADER_LINE_P (w)
!= MATRIX_HEADER_LINE_ROW (w->current_matrix)->mode_line_p)
- return 0;
+ return false;
/* Give up if old or new display is scrolled vertically. We could
make this function handle this, but right now it doesn't. */
start_row = MATRIX_FIRST_TEXT_ROW (w->current_matrix);
if (w->vscroll || MATRIX_ROW_PARTIALLY_VISIBLE_P (w, start_row))
- return 0;
+ return false;
/* The variable new_start now holds the new window start. The old
start `start' can be determined from the current matrix. */
below, and it's certainly not worth the effort since this is
not a frequent case. */
if (in_ellipses_for_invisible_text_p (&start_row->start, w))
- return 0;
+ return false;
IF_DEBUG (debug_method_add (w, "twu1"));
|| CHARPOS (start) == ZV)
{
clear_glyph_matrix (w->desired_matrix);
- return 0;
+ return false;
}
start_vpos = MATRIX_ROW_VPOS (start_row, w->current_matrix);
else
{
clear_glyph_matrix (w->desired_matrix);
- return 0;
+ return false;
}
}
FRAME_RIF (f)->update_window_begin_hook (w);
FRAME_RIF (f)->clear_window_mouse_face (w);
FRAME_RIF (f)->scroll_run_hook (w, &run);
- FRAME_RIF (f)->update_window_end_hook (w, 0, 0);
+ FRAME_RIF (f)->update_window_end_hook (w, false, false);
update_end (f);
}
if (row->y + row->height > max_y)
row->visible_height -= row->y + row->height - max_y;
if (row->fringe_bitmap_periodic_p)
- row->redraw_fringe_bitmaps_p = 1;
+ row->redraw_fringe_bitmaps_p = true;
it.current_y += row->height;
/* Disable lines in the current matrix which are now
below the window. */
for (++row; row < bottom_row; ++row)
- row->enabled_p = row->mode_line_p = 0;
+ row->enabled_p = row->mode_line_p = false;
}
/* Update window_end_pos etc.; last_reused_text_row is the last
The value of last_text_row is the last displayed line
containing text. */
if (last_reused_text_row)
- adjust_window_ends (w, last_reused_text_row, 1);
+ adjust_window_ends (w, last_reused_text_row, true);
else if (last_text_row)
- adjust_window_ends (w, last_text_row, 0);
+ adjust_window_ends (w, last_text_row, false);
else
{
/* This window must be completely empty. */
w->window_end_pos = Z - ZV;
w->window_end_vpos = 0;
}
- w->window_end_valid = 0;
+ w->window_end_valid = false;
/* Update hint: don't try scrolling again in update_window. */
- w->desired_matrix->no_scrolling_p = 1;
+ w->desired_matrix->no_scrolling_p = true;
#ifdef GLYPH_DEBUG
debug_method_add (w, "try_window_reusing_current_matrix 1");
#endif
- return 1;
+ return true;
}
else if (CHARPOS (new_start) > CHARPOS (start))
{
|| !first_reusable_row->enabled_p
|| (MATRIX_ROW_START_CHARPOS (first_reusable_row)
!= CHARPOS (new_start)))
- return 0;
+ return false;
/* We can reuse fully visible rows beginning with
first_reusable_row to the end of the window. Set
if (w->cursor.vpos < 0)
{
clear_glyph_matrix (w->desired_matrix);
- return 0;
+ return false;
}
/* Scroll the display. */
FRAME_RIF (f)->update_window_begin_hook (w);
FRAME_RIF (f)->clear_window_mouse_face (w);
FRAME_RIF (f)->scroll_run_hook (w, &run);
- FRAME_RIF (f)->update_window_end_hook (w, 0, 0);
+ FRAME_RIF (f)->update_window_end_hook (w, false, false);
update_end (f);
}
if (row->y + row->height > max_y)
row->visible_height -= row->y + row->height - max_y;
if (row->fringe_bitmap_periodic_p)
- row->redraw_fringe_bitmaps_p = 1;
+ row->redraw_fringe_bitmaps_p = true;
}
/* Scroll the current matrix. */
0, 0, 0, 0))
{
clear_glyph_matrix (w->desired_matrix);
- return 0;
+ return false;
}
}
else
the window end is in reused rows which in turn means that
only its vpos can have changed. */
if (last_text_row)
- adjust_window_ends (w, last_text_row, 0);
+ adjust_window_ends (w, last_text_row, false);
else
w->window_end_vpos -= nrows_scrolled;
- w->window_end_valid = 0;
- w->desired_matrix->no_scrolling_p = 1;
+ w->window_end_valid = false;
+ w->desired_matrix->no_scrolling_p = true;
#ifdef GLYPH_DEBUG
debug_method_add (w, "try_window_reusing_current_matrix 2");
#endif
- return 1;
+ return true;
}
- return 0;
+ return false;
}
last_y = window_text_bottom_y (w) - dy;
- while (1)
+ while (true)
{
/* Give up if we have gone too far. */
if (end && row >= end)
/* Try to redisplay window W by reusing its existing display. W's
current matrix must be up to date when this function is called,
- i.e. window_end_valid must be nonzero.
+ i.e., window_end_valid must be true.
Value is
#endif
/* This is handy for debugging. */
-#if 0
+#if false
#define GIVE_UP(X) \
do { \
fprintf (stderr, "try_window_id give up %d\n", (X)); \
return 0; \
- } while (0)
+ } while (false)
#else
#define GIVE_UP(X) return 0
#endif
if (MATRIX_ROW_ENDS_IN_MIDDLE_OF_CHAR_P (last_unchanged_at_beg_row))
GIVE_UP (17);
- if (init_to_row_end (&it, w, last_unchanged_at_beg_row) == 0)
+ if (! init_to_row_end (&it, w, last_unchanged_at_beg_row))
GIVE_UP (18);
start_pos = it.current.pos;
line where the window_end_vpos is. */
w->cursor.vpos = -1;
last_text_row = NULL;
- overlay_arrow_seen = 0;
+ overlay_arrow_seen = false;
if (it.current_y < it.last_visible_y
&& !f->fonts_changed
&& (first_unchanged_at_end_row == NULL
FRAME_RIF (f)->update_window_begin_hook (w);
FRAME_RIF (f)->clear_window_mouse_face (w);
FRAME_RIF (f)->scroll_run_hook (w, &run);
- FRAME_RIF (f)->update_window_end_hook (w, 0, 0);
+ FRAME_RIF (f)->update_window_end_hook (w, false, false);
}
else
{
= MATRIX_ROW_VPOS (first_unchanged_at_end_row, w->current_matrix);
int from = WINDOW_TOP_EDGE_LINE (w) + from_vpos;
int end = (WINDOW_TOP_EDGE_LINE (w)
- + (WINDOW_WANTS_HEADER_LINE_P (w) ? 1 : 0)
+ + WINDOW_WANTS_HEADER_LINE_P (w)
+ window_internal_height (w));
#if defined (HAVE_GPM) || defined (MSDOS)
/* Is it always sure that the display agrees with lines in
the current matrix? I don't think so, so we mark rows
displayed invalid in the current matrix by setting their
- enabled_p flag to zero. */
+ enabled_p flag to false. */
SET_MATRIX_ROW_ENABLED_P (w->current_matrix, it.vpos, false);
if (display_line (&it))
last_text_row_at_end = it.glyph_row - 1;
row = find_last_row_displaying_text (w->current_matrix, &it,
first_unchanged_at_end_row);
eassert (row && MATRIX_ROW_DISPLAYS_TEXT_P (row));
- adjust_window_ends (w, row, 1);
+ adjust_window_ends (w, row, true);
eassert (w->window_end_bytepos >= 0);
IF_DEBUG (debug_method_add (w, "A"));
}
else if (last_text_row_at_end)
{
- adjust_window_ends (w, last_text_row_at_end, 0);
+ adjust_window_ends (w, last_text_row_at_end, false);
eassert (w->window_end_bytepos >= 0);
IF_DEBUG (debug_method_add (w, "B"));
}
/* 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. */
- adjust_window_ends (w, last_text_row, 0);
+ adjust_window_ends (w, last_text_row, false);
eassert (w->window_end_bytepos >= 0);
}
else if (first_unchanged_at_end_row == NULL
{
/* Displayed to end of window, but no line containing text was
displayed. Lines were deleted at the end of the window. */
- int first_vpos = WINDOW_WANTS_HEADER_LINE_P (w) ? 1 : 0;
+ bool first_vpos = WINDOW_WANTS_HEADER_LINE_P (w);
int vpos = w->window_end_vpos;
struct glyph_row *current_row = current_matrix->rows + vpos;
struct glyph_row *desired_row = desired_matrix->rows + vpos;
debug_end_vpos = w->window_end_vpos));
/* Record that display has not been completed. */
- w->window_end_valid = 0;
- w->desired_matrix->no_scrolling_p = 1;
+ w->window_end_valid = false;
+ w->desired_matrix->no_scrolling_p = true;
return 3;
#undef GIVE_UP
glyph->left_box_line_p,
glyph->right_box_line_p);
}
-#ifdef HAVE_XWIDGETS
- else if (glyph->type == XWIDGET_GLYPH)
- {
- fprintf (stderr,
- " %5d %4c %6d %c %3d 0x%05x %c %4d %1.1d%1.1d\n",
- glyph - row->glyphs[TEXT_AREA],
- 'X',
- glyph->charpos,
- (BUFFERP (glyph->object)
- ? 'B'
- : (STRINGP (glyph->object)
- ? 'S'
- : '-')),
- glyph->pixel_width,
- glyph->u.xwidget,
- '.',
- glyph->face_id,
- glyph->left_box_line_p,
- glyph->right_box_line_p);
-
- }
-#endif
}
/* Append one space to the glyph row of iterator IT if doing a
window-based redisplay. The space has the same face as
- IT->face_id. Value is non-zero if a space was added.
+ IT->face_id. Value is true if a space was added.
This function is called to make sure that there is always one glyph
at the end of a glyph row that the cursor can be set on under
At the same time this space let's a nicely handle clearing to the
end of the line if the row ends in italic text. */
-static int
-append_space_for_newline (struct it *it, int default_face_p)
+static bool
+append_space_for_newline (struct it *it, bool default_face_p)
{
if (FRAME_WINDOW_P (it->f))
{
int saved_char_to_display = it->char_to_display;
int saved_x = it->current_x;
int saved_face_id = it->face_id;
- int saved_box_end = it->end_of_box_run_p;
+ bool saved_box_end = it->end_of_box_run_p;
struct text_pos saved_pos;
Lisp_Object saved_object;
struct face *face;
the end of the row, there will be no stretch glyph,
so leave the box flag set. */
&& saved_x + FRAME_COLUMN_WIDTH (it->f) < it->last_visible_x)
- it->end_of_box_run_p = 0;
+ it->end_of_box_run_p = false;
PRODUCE_GLYPHS (it);
it->override_ascent = -1;
- it->constrain_row_ascent_descent_p = 0;
+ it->constrain_row_ascent_descent_p = false;
it->current_x = saved_x;
it->object = saved_object;
it->position = saved_pos;
it->c = saved_c;
it->char_to_display = saved_char_to_display;
it->end_of_box_run_p = saved_box_end;
- return 1;
+ return true;
}
}
- return 0;
+ return false;
}
/* Set the glyph row flag indicating that the face of the last glyph
in the text area has to be drawn to the end of the text area. */
- it->glyph_row->fill_line_p = 1;
+ it->glyph_row->fill_line_p = true;
/* If current character of IT is not ASCII, make sure we have the
ASCII face. This will be automatically undone the next time
struct glyph *g;
int row_width, stretch_ascent, stretch_width;
struct text_pos saved_pos;
- int saved_face_id, saved_avoid_cursor, saved_box_start;
+ int saved_face_id;
+ bool saved_avoid_cursor, saved_box_start;
for (row_width = 0, g = row_start; g < row_end; g++)
row_width += g->pixel_width;
saved_pos = it->position;
memset (&it->position, 0, sizeof it->position);
saved_avoid_cursor = it->avoid_cursor_p;
- it->avoid_cursor_p = 1;
+ it->avoid_cursor_p = true;
saved_face_id = it->face_id;
saved_box_start = it->start_of_box_run_p;
/* The last row's stretch glyph should get the default
it->face_id = default_face->id;
else
it->face_id = face->id;
- it->start_of_box_run_p = 0;
+ it->start_of_box_run_p = false;
append_stretch_glyph (it, Qnil, stretch_width,
it->ascent + it->descent, stretch_ascent);
it->position = saved_pos;
}
-/* Value is non-zero if text starting at CHARPOS in current_buffer is
+/* Value is true if text starting at CHARPOS in current_buffer is
trailing whitespace. */
-static int
+static bool
trailing_whitespace_p (ptrdiff_t charpos)
{
ptrdiff_t bytepos = CHAR_TO_BYTE (charpos);
if (bytepos >= ZV_BYTE || c == '\n' || c == '\r')
{
if (bytepos != PT_BYTE)
- return 1;
+ return true;
}
- return 0;
+ return false;
}
}
-/* Value is non-zero if glyph row ROW should be
+/* Value is true if glyph row ROW should be
considered to hold the buffer position CHARPOS. */
-static int
+static bool
row_for_charpos_p (struct glyph_row *row, ptrdiff_t charpos)
{
- int result = 1;
+ bool result = true;
if (charpos == CHARPOS (row->end.pos)
|| charpos == MATRIX_ROW_END_CHARPOS (row))
if (CHARPOS (row->end.string_pos) >= 0)
{
if (row->continued_p)
- result = 1;
+ result = true;
else
{
/* Check for `display' property. */
struct glyph *end = beg + row->used[TEXT_AREA] - 1;
struct glyph *glyph;
- result = 0;
+ result = false;
for (glyph = end; glyph >= beg; --glyph)
if (STRINGP (glyph->object))
{
if (!NILP (Fget_char_property (make_number (gpos),
Qcursor, s)))
{
- result = 1;
+ result = true;
break;
}
}
CHARPOS (ROW->end.pos) will equal point after the
invisible text. We want that position to be displayed
after the ellipsis. */
- result = 0;
+ result = false;
}
/* If the row ends at ZV, display the cursor at the end of that
row instead of at the start of the row below. */
- else if (row->ends_at_zv_p)
- result = 1;
else
- result = 0;
+ result = row->ends_at_zv_p;
}
return result;
}
-/* Value is non-zero if glyph row ROW should be
+/* Value is true if glyph row ROW should be
used to hold the cursor. */
-static int
+static bool
cursor_row_p (struct glyph_row *row)
{
return row_for_charpos_p (row, PT);
\f
/* Push the property PROP so that it will be rendered at the current
- position in IT. Return 1 if PROP was successfully pushed, 0
+ position in IT. Return true if PROP was successfully pushed, false
otherwise. Called from handle_line_prefix to handle the
`line-prefix' and `wrap-prefix' properties. */
-static int
+static bool
push_prefix_prop (struct it *it, Lisp_Object prop)
{
struct text_pos pos =
if (SCHARS (prop) == 0)
{
pop_it (it);
- return 0;
+ return false;
}
it->string = prop;
- it->string_from_prefix_prop_p = 1;
+ it->string_from_prefix_prop_p = true;
it->multibyte_p = STRING_MULTIBYTE (it->string);
it->current.overlay_string_index = -1;
IT_STRING_CHARPOS (*it) = IT_STRING_BYTEPOS (*it) = 0;
else
{
pop_it (it); /* bogus display property, give up */
- return 0;
+ return false;
}
- return 1;
+ return true;
}
/* Return the character-property PROP at the current position in IT. */
it, it would acquire its own wrap prefix, and so on till the
iterator stack overflows. So, don't wrap the prefix. */
it->line_wrap = TRUNCATE;
- it->avoid_cursor_p = 1;
+ it->avoid_cursor_p = true;
}
}
row->maxpos = it->current.pos;
else if (row->used[TEXT_AREA])
{
- int seen_this_string = 0;
+ bool seen_this_string = false;
struct glyph_row *r1 = row - 1;
/* Did we see the same display string on the previous row? */
if (end > start)
{
if (EQ ((end - 1)->object, it->object))
- seen_this_string = 1;
+ seen_this_string = true;
}
else
/* If all the glyphs of the previous row were inserted
produced from a single newline, which is only
possible if that newline came from the same string
as the one which produced this ROW. */
- seen_this_string = 1;
+ seen_this_string = true;
}
else
{
if (end < start)
{
if (EQ ((end + 1)->object, it->object))
- seen_this_string = 1;
+ seen_this_string = true;
}
else
- seen_this_string = 1;
+ seen_this_string = true;
}
}
/* Take note of each display string that covers a newline only
/* Construct the glyph row IT->glyph_row in the desired matrix of
IT->w from text at the current position of IT. See dispextern.h
- for an overview of struct it. Value is non-zero if
+ for an overview of struct it. Value is true if
IT->glyph_row displays text, as opposed to a line displaying ZV
only. */
-static int
+static bool
display_line (struct it *it)
{
struct glyph_row *row = it->glyph_row;
Lisp_Object overlay_arrow_string;
struct it wrap_it;
void *wrap_data = NULL;
- int may_wrap = 0, wrap_x IF_LINT (= 0);
+ bool may_wrap = false;
+ int wrap_x IF_LINT (= 0);
int wrap_row_used = -1;
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);
>= it->w->desired_matrix->nrows)
{
it->w->nrows_scale_factor++;
- it->f->fonts_changed = 1;
- return 0;
+ it->f->fonts_changed = true;
+ return false;
}
/* Clear the result glyph row and enable it. */
row->y = it->current_y;
row->start = it->start;
row->continuation_lines_width = it->continuation_lines_width;
- row->displays_text_p = 1;
+ row->displays_text_p = true;
row->starts_in_middle_of_char_p = it->starts_in_middle_of_char_p;
- it->starts_in_middle_of_char_p = 0;
+ it->starts_in_middle_of_char_p = false;
/* Arrange the overlays nicely for our purposes. Usually, we call
display_line on only one line at a time, in which case this
#define RECORD_MAX_MIN_POS(IT) \
do \
{ \
- int composition_p = !STRINGP ((IT)->string) \
- && ((IT)->what == IT_COMPOSITION); \
+ bool composition_p \
+ = !STRINGP ((IT)->string) && ((IT)->what == IT_COMPOSITION); \
ptrdiff_t current_pos = \
composition_p ? (IT)->cmp_it.charpos \
: IT_CHARPOS (*(IT)); \
max_bpos = IT_BYTEPOS (*it); \
} \
} \
- while (0)
+ while (false)
/* Loop generating characters. The loop is left with IT on the next
character to display. */
- while (1)
+ while (true)
{
int n_glyphs_before, hpos_before, x_before;
int x, nglyphs;
int ascent = 0, descent = 0, phys_ascent = 0, phys_descent = 0;
- /* Retrieve the next thing to display. Value is zero if end of
+ /* Retrieve the next thing to display. Value is false if end of
buffer reached. */
if (!get_next_display_element (it))
{
first glyph of blank lines not corresponding to any text
to -1. */
if (IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
- row->exact_window_width_line_p = 1;
- else if ((append_space_for_newline (it, 1) && row->used[TEXT_AREA] == 1)
+ row->exact_window_width_line_p = true;
+ else if ((append_space_for_newline (it, true)
+ && row->used[TEXT_AREA] == 1)
|| row->used[TEXT_AREA] == 0)
{
row->glyphs[TEXT_AREA]->charpos = -1;
- row->displays_text_p = 0;
+ row->displays_text_p = false;
if (!NILP (BVAR (XBUFFER (it->w->contents), indicate_empty_lines))
&& (!MINI_WINDOW_P (it->w)
|| (minibuf_level && EQ (it->window, minibuf_window))))
- row->indicate_empty_line_p = 1;
+ row->indicate_empty_line_p = true;
}
it->continuation_lines_width = 0;
- row->ends_at_zv_p = 1;
+ row->ends_at_zv_p = true;
/* A row that displays right-to-left text must always have
its last face extended all the way to the end of line,
even if this row ends in ZV, because we still write to
if (it->line_wrap == WORD_WRAP && it->area == TEXT_AREA)
{
if (IT_DISPLAYING_WHITESPACE (it))
- may_wrap = 1;
+ may_wrap = true;
else if (may_wrap)
{
SAVE_IT (wrap_it, *it, wrap_data);
wrap_row_min_bpos = min_bpos;
wrap_row_max_pos = max_pos;
wrap_row_max_bpos = max_bpos;
- may_wrap = 0;
+ may_wrap = false;
}
}
}
it->max_phys_ascent + it->max_phys_descent);
row->extra_line_spacing = max (row->extra_line_spacing,
it->max_extra_line_spacing);
- set_iterator_to_next (it, 1);
+ set_iterator_to_next (it, true);
/* If we didn't handle the line/wrap prefix above, and the
call to set_iterator_to_next just switched to TEXT_AREA,
process the prefix now. */
fits exactly on the line. We must continue
the line because we can't draw the cursor
after the glyph. */
- row->continued_p = 1;
+ row->continued_p = true;
it->current_x = new_x;
it->continuation_lines_width += new_x;
++it->hpos;
displayed by this row. */
if (it->bidi_p)
RECORD_MAX_MIN_POS (it);
- set_iterator_to_next (it, 1);
+ set_iterator_to_next (it, true);
if (IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
{
if (!get_next_display_element (it))
{
- row->exact_window_width_line_p = 1;
+ row->exact_window_width_line_p = true;
it->continuation_lines_width = 0;
- row->continued_p = 0;
- row->ends_at_zv_p = 1;
+ row->continued_p = false;
+ row->ends_at_zv_p = true;
}
else if (ITERATOR_AT_END_OF_LINE_P (it))
{
- row->continued_p = 0;
- row->exact_window_width_line_p = 1;
+ row->continued_p = false;
+ row->exact_window_width_line_p = true;
}
/* If line-wrap is on, check if a
previous wrap point was found. */
< row->glyphs[1 + TEXT_AREA])
produce_special_glyphs (it, IT_CONTINUATION);
- row->continued_p = 1;
+ row->continued_p = true;
it->current_x = x_before;
it->continuation_lines_width += x_before;
min_bpos = wrap_row_min_bpos;
max_pos = wrap_row_max_pos;
max_bpos = wrap_row_max_bpos;
- row->continued_p = 1;
- row->ends_at_zv_p = 0;
- row->exact_window_width_line_p = 0;
+ row->continued_p = true;
+ row->ends_at_zv_p = false;
+ row->exact_window_width_line_p = false;
it->continuation_lines_width += x;
/* Make sure that a non-default face is extended
: 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->ends_in_middle_of_char_p = true;
+ row->continued_p = true;
glyph->pixel_width = it->last_visible_x - x;
- it->starts_in_middle_of_char_p = 1;
+ it->starts_in_middle_of_char_p = true;
if (WINDOW_LEFT_MARGIN_WIDTH (it->w) > 0
|| WINDOW_RIGHT_MARGIN_WIDTH (it->w) > 0)
extend_face_to_end_of_line (it);
? WINDOW_LEFT_FRINGE_WIDTH (it->w)
: WINDOW_RIGHT_FRINGE_WIDTH (it->w)) == 0)
produce_special_glyphs (it, IT_CONTINUATION);
- row->continued_p = 1;
+ row->continued_p = true;
extend_face_to_end_of_line (it);
if (nglyphs > 1 && i > 0)
{
- row->ends_in_middle_of_char_p = 1;
- it->starts_in_middle_of_char_p = 1;
+ row->ends_in_middle_of_char_p = true;
+ it->starts_in_middle_of_char_p = true;
}
/* Restore the height to what it was before the
/* Add a space at the end of the line that is used to
display the cursor there. */
if (!IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
- append_space_for_newline (it, 0);
+ append_space_for_newline (it, false);
/* Extend the face to the end of the line. */
extend_face_to_end_of_line (it);
it->eol_pos = it->current.pos;
/* Consume the line end. This skips over invisible lines. */
- set_iterator_to_next (it, 1);
+ set_iterator_to_next (it, true);
it->continuation_lines_width = 0;
break;
}
/* Proceed with next display element. Note that this skips
over lines invisible because of selective display. */
- set_iterator_to_next (it, 1);
+ set_iterator_to_next (it, true);
/* If we truncate lines, we are done when the last displayed
glyphs reach past the right margin of the window. */
if (!get_next_display_element (it))
{
it->continuation_lines_width = 0;
- row->ends_at_zv_p = 1;
- row->exact_window_width_line_p = 1;
+ row->ends_at_zv_p = true;
+ row->exact_window_width_line_p = true;
break;
}
if (ITERATOR_AT_END_OF_LINE_P (it))
{
- row->exact_window_width_line_p = 1;
+ row->exact_window_width_line_p = true;
goto at_end_of_line;
}
it->current_x = x_before;
it->hpos = hpos_before;
}
- row->truncated_on_right_p = 1;
+ row->truncated_on_right_p = true;
it->continuation_lines_width = 0;
- reseat_at_next_visible_line_start (it, 0);
+ reseat_at_next_visible_line_start (it, false);
/* We insist below that IT's position be at ZV because in
bidi-reordered lines the character at visible line start
might not be the character that follows the newline in
}
if (wrap_data)
- bidi_unshelve_cache (wrap_data, 1);
+ bidi_unshelve_cache (wrap_data, true);
/* If line is not empty and hscrolled, maybe insert truncation glyphs
at the left window margin. */
first glyph of the row if it is an image. */
&& row->glyphs[TEXT_AREA]->type != IMAGE_GLYPH))
insert_left_trunc_glyphs (it);
- row->truncated_on_left_p = 1;
+ row->truncated_on_left_p = true;
}
/* Remember the position at which this line ends.
eassert (INTEGERP (overlay_arrow_string));
row->overlay_arrow_bitmap = XINT (overlay_arrow_string);
}
- overlay_arrow_seen = 1;
+ overlay_arrow_seen = true;
}
/* Highlight trailing whitespace. */
itb.string.s = NULL;
itb.string.lstring = Qnil;
itb.string.bufpos = 0;
- itb.string.from_disp_str = 0;
- itb.string.unibyte = 0;
+ itb.string.from_disp_str = false;
+ itb.string.unibyte = false;
/* We have no window to use here for ignoring window-specific
overlays. Using NULL for window pointer will cause
compute_display_string_pos to use the current buffer. */
itb.w = NULL;
- bidi_paragraph_init (NEUTRAL_DIR, &itb, 1);
- bidi_unshelve_cache (itb_data, 0);
+ bidi_paragraph_init (NEUTRAL_DIR, &itb, true);
+ bidi_unshelve_cache (itb_data, false);
set_buffer_temp (old);
switch (itb.paragraph_dir)
{
itb.string.s = NULL;
itb.string.schars = SCHARS (object);
itb.string.bufpos = 0;
- itb.string.from_disp_str = 0;
- itb.string.unibyte = 0;
+ itb.string.from_disp_str = false;
+ itb.string.unibyte = false;
itb.w = w;
bidi_init_it (0, 0, frame_window_p, &itb);
}
itb.string.s = NULL;
itb.string.lstring = Qnil;
itb.string.bufpos = 0;
- itb.string.from_disp_str = 0;
- itb.string.unibyte = 0;
+ itb.string.from_disp_str = false;
+ itb.string.unibyte = false;
itb.w = w;
bidi_init_it (itb.charpos, itb.bytepos, frame_window_p, &itb);
}
do {
/* For the purposes of this function, the actual base direction of
the paragraph doesn't matter, so just set it to L2R. */
- bidi_paragraph_init (L2R, &itb, 0);
+ bidi_paragraph_init (L2R, &itb, false);
while ((found = bidi_find_first_overridden (&itb)) < from_pos)
;
} while (found == ZV && itb.ch == '\n' && itb.charpos < to_pos);
- bidi_unshelve_cache (itb_data, 0);
+ bidi_unshelve_cache (itb_data, false);
set_buffer_temp (old);
return (from_pos <= found && found < to_pos) ? make_number (found) : Qnil;
while (!ITERATOR_AT_END_OF_LINE_P (&it))
{
- set_iterator_to_next (&it, 0);
+ set_iterator_to_next (&it, false);
if (it.method == GET_FROM_BUFFER)
new_pos = it.current.pos;
if (!get_next_display_element (&it))
{
while (IT_CHARPOS (it) == PT)
{
- set_iterator_to_next (&it, 0);
+ set_iterator_to_next (&it, false);
if (!get_next_display_element (&it))
break;
}
struct glyph_row *row = it.glyph_row + i;
clear_glyph_row (row);
row->enabled_p = true;
- row->full_width_p = 1;
+ row->full_width_p = true;
row->reversed_p = false;
}
glyph number in the row, starting from left, where to start
displaying the item.
- SUBMENU non-zero means this menu item drops down a submenu, which
+ SUBMENU means this menu item drops down a submenu, which
should be indicated by displaying a proper visual cue after the
item text. */
void
display_tty_menu_item (const char *item_text, int width, int face_id,
- int x, int y, int submenu)
+ int x, int y, bool submenu)
{
struct it it;
struct frame *f = SELECTED_FRAME ();
struct window *w = XWINDOW (f->selected_window);
- int saved_used, saved_truncated, saved_width, saved_reversed;
struct glyph_row *row;
size_t item_len = strlen (item_text);
row = it.glyph_row;
/* Start with the row contents from the current matrix. */
deep_copy_glyph_row (row, f->current_matrix->rows + y);
- saved_width = row->full_width_p;
- row->full_width_p = 1;
- saved_reversed = row->reversed_p;
- row->reversed_p = 0;
+ bool saved_width = row->full_width_p;
+ row->full_width_p = true;
+ bool saved_reversed = row->reversed_p;
+ row->reversed_p = false;
row->enabled_p = true;
/* Arrange for the menu item glyphs to start at (X,Y) and have the
eassert (x < f->desired_matrix->matrix_w);
it.current_x = it.hpos = x;
it.current_y = it.vpos = y;
- saved_used = row->used[TEXT_AREA];
- saved_truncated = row->truncated_on_right_p;
+ int saved_used = row->used[TEXT_AREA];
+ bool saved_truncated = row->truncated_on_right_p;
row->used[TEXT_AREA] = x;
it.face_id = face_id;
it.line_wrap = TRUNCATE;
Mode Line
***********************************************************************/
-/* Redisplay mode lines in the window tree whose root is WINDOW. If
- FORCE is non-zero, redisplay mode lines unconditionally.
+/* Redisplay mode lines in the window tree whose root is WINDOW.
+ If FORCE, redisplay mode lines unconditionally.
Otherwise, redisplay only mode lines that are garbaged. Value is
the number of windows whose mode lines were redisplayed. */
XFRAME (new_frame)->selected_window = selected_window;
/* These will be set while the mode line specs are processed. */
- line_number_displayed = 0;
+ line_number_displayed = false;
w->column_number_displayed = -1;
if (WINDOW_WANTS_MODELINE_P (w))
it.glyph_row->enabled_p = false;
prepare_desired_row (w, it.glyph_row, true);
- it.glyph_row->mode_line_p = 1;
+ it.glyph_row->mode_line_p = true;
/* FIXME: This should be controlled by a user option. But
supporting such an option is not trivial, since the mode line is
it.paragraph_embedding = L2R;
record_unwind_protect (unwind_format_mode_line,
- format_mode_line_unwind_data (NULL, NULL, Qnil, 0));
+ format_mode_line_unwind_data (NULL, NULL,
+ Qnil, false));
mode_line_target = MODE_LINE_DISPLAY;
values. */
push_kboard (FRAME_KBOARD (it.f));
record_unwind_save_match_data ();
- display_mode_element (&it, 0, 0, 0, format, Qnil, 0);
+ display_mode_element (&it, 0, 0, 0, format, Qnil, false);
pop_kboard ();
unbind_to (count, Qnil);
display_string (" ", Qnil, Qnil, 0, 0, &it, 10000, -1, -1, 0);
compute_line_metrics (&it);
- it.glyph_row->full_width_p = 1;
- it.glyph_row->continued_p = 0;
- it.glyph_row->truncated_on_left_p = 0;
- it.glyph_row->truncated_on_right_p = 0;
+ it.glyph_row->full_width_p = true;
+ it.glyph_row->continued_p = false;
+ it.glyph_row->truncated_on_left_p = false;
+ it.glyph_row->truncated_on_right_p = false;
/* Make a 3D mode-line have a shadow at its right end. */
face = FACE_FROM_ID (it.f, face_id);
{
struct glyph *last = (it.glyph_row->glyphs[TEXT_AREA]
+ it.glyph_row->used[TEXT_AREA] - 1);
- last->right_box_line_p = 1;
+ last->right_box_line_p = true;
}
return it.glyph_row->height;
PROPS is a property list to add to any string we encounter.
- If RISKY is nonzero, remove (disregard) any properties in any string
+ If RISKY, remove (disregard) any properties in any string
we encounter, and ignore :eval and :propertize.
The global variable `mode_line_target' determines whether the
static int
display_mode_element (struct it *it, int depth, int field_width, int precision,
- Lisp_Object elt, Lisp_Object props, int risky)
+ Lisp_Object elt, Lisp_Object props, bool risky)
{
int n = 0, field, prec;
- int literal = 0;
+ bool literal = false;
tail_recurse:
if (depth > 100)
n += store_mode_line_noprop (SSDATA (elt), -1, prec);
break;
case MODE_LINE_STRING:
- n += store_mode_line_string (NULL, elt, 1, 0, prec, Qnil);
+ n += store_mode_line_string (NULL, elt, true, 0, prec, Qnil);
break;
case MODE_LINE_DISPLAY:
n += display_string (NULL, elt, Qnil, 0, 0, it,
ptrdiff_t endpos = (precision <= 0
? string_byte_to_char (elt, offset)
: charpos + nchars);
-
- n += store_mode_line_string (NULL,
- Fsubstring (elt, make_number (charpos),
- make_number (endpos)),
- 0, 0, 0, Qnil);
+ Lisp_Object mode_string
+ = Fsubstring (elt, make_number (charpos),
+ make_number (endpos));
+ n += store_mode_line_string (NULL, mode_string, false,
+ 0, 0, Qnil);
}
break;
case MODE_LINE_DISPLAY:
Lisp_Object tem = build_string (spec);
props = Ftext_properties_at (make_number (charpos), elt);
/* Should only keep face property in props */
- n += store_mode_line_string (NULL, tem, 0, field, prec, props);
+ n += store_mode_line_string (NULL, tem, false,
+ field, prec, props);
}
break;
case MODE_LINE_DISPLAY:
/* If the variable is not marked as risky to set
then its contents are risky to use. */
if (NILP (Fget (elt, Qrisky_local_variable)))
- risky = 1;
+ risky = true;
tem = Fboundp (elt);
if (!NILP (tem))
/* If value is a string, output that string literally:
don't check for % within it. */
if (STRINGP (tem))
- literal = 1;
+ literal = true;
if (!EQ (tem, elt))
{
n += store_mode_line_noprop ("", field_width - n, 0);
break;
case MODE_LINE_STRING:
- n += store_mode_line_string ("", Qnil, 0, field_width - n, 0, Qnil);
+ n += store_mode_line_string ("", Qnil, false, field_width - n, 0,
+ Qnil);
break;
case MODE_LINE_DISPLAY:
n += display_string ("", Qnil, Qnil, 0, 0, it, field_width - n,
PRECISION is the maximum number of characters to output from
STRING. PRECISION <= 0 means don't truncate the string.
- If COPY_STRING is non-zero, make a copy of LISP_STRING before adding
+ If COPY_STRING, make a copy of LISP_STRING before adding
properties to the string.
PROPS are the properties to add to the string.
*/
static int
-store_mode_line_string (const char *string, Lisp_Object lisp_string, int copy_string,
+store_mode_line_string (const char *string, Lisp_Object lisp_string,
+ bool copy_string,
int field_width, int precision, Lisp_Object props)
{
ptrdiff_t len;
struct window *w;
struct buffer *old_buffer = NULL;
int face_id;
- int no_props = INTEGERP (face);
+ bool no_props = INTEGERP (face);
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object str;
int string_start = 0;
record_unwind_protect (unwind_format_mode_line,
format_mode_line_unwind_data
(XFRAME (WINDOW_FRAME (w)),
- old_buffer, selected_window, 1));
+ old_buffer, selected_window, true));
mode_line_proptrans_alist = Qnil;
Fselect_window (window, Qt);
}
push_kboard (FRAME_KBOARD (it.f));
- display_mode_element (&it, 0, 0, 0, format, Qnil, 0);
+ display_mode_element (&it, 0, 0, 0, format, Qnil, false);
pop_kboard ();
if (no_props)
else
{
mode_line_string_list = Fnreverse (mode_line_string_list);
- str = Fmapconcat (intern ("identity"), mode_line_string_list,
+ str = Fmapconcat (Qidentity, mode_line_string_list,
empty_unibyte_string);
}
}
/* Set a mnemonic character for coding_system (Lisp symbol) in BUF.
- If EOL_FLAG is 1, set also a mnemonic character for end-of-line
+ If EOL_FLAG, set also a mnemonic character for end-of-line
type of CODING_SYSTEM. Return updated pointer into BUF. */
static unsigned char invalid_eol_type[] = "(*invalid*)";
static char *
-decode_mode_spec_coding (Lisp_Object coding_system, register char *buf, int eol_flag)
+decode_mode_spec_coding (Lisp_Object coding_system, char *buf, bool eol_flag)
{
Lisp_Object val;
bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
else /* eolvalue is Qunix, Qdos, or Qmac. */
eoltype = (EQ (eolvalue, Qunix)
? eol_mnemonic_unix
- : (EQ (eolvalue, Qdos) == 1
- ? eol_mnemonic_dos : eol_mnemonic_mac));
+ : EQ (eolvalue, Qdos)
+ ? eol_mnemonic_dos : eol_mnemonic_mac);
}
}
PT_BYTE, PT, &junk);
/* Record that we did display the line number. */
- line_number_displayed = 1;
+ line_number_displayed = true;
/* Make the string to show. */
pint2str (decode_mode_spec_buf, width, topline + nlines);
case 'Z':
/* coding-system (including end-of-line type) */
{
- int eol_flag = (c == 'Z');
+ bool eol_flag = (c == 'Z');
char *p = decode_mode_spec_buf;
if (! FRAME_WINDOW_P (f))
to do EOL conversion. */
p = decode_mode_spec_coding (CODING_ID_NAME
(FRAME_KEYBOARD_CODING (f)->id),
- p, 0);
+ p, false);
p = decode_mode_spec_coding (CODING_ID_NAME
(FRAME_TERMINAL_CODING (f)->id),
- p, 0);
+ p, false);
}
p = decode_mode_spec_coding (BVAR (b, buffer_file_coding_system),
p, eol_flag);
-#if 0 /* This proves to be annoying; I think we can do without. -- rms. */
+#if false /* This proves to be annoying; I think we can do without. -- rms. */
#ifdef subprocesses
obj = Fget_buffer_process (Fcurrent_buffer ());
if (PROCESSP (obj))
(XPROCESS (obj)->encode_coding_system, p, eol_flag);
}
#endif /* subprocesses */
-#endif /* 0 */
+#endif /* false */
*p = 0;
return decode_mode_spec_buf;
}
/* If we are not in selective display mode,
check only for newlines. */
- int selective_display = (!NILP (BVAR (current_buffer, selective_display))
- && !INTEGERP (BVAR (current_buffer, selective_display)));
+ bool selective_display
+ = (!NILP (BVAR (current_buffer, selective_display))
+ && !INTEGERP (BVAR (current_buffer, selective_display)));
if (count > 0)
{
ceiling = max (limit_byte, ceiling);
ceiling_addr = BYTE_POS_ADDR (ceiling);
base = (cursor = BYTE_POS_ADDR (start_byte - 1) + 1);
- while (1)
+ while (true)
{
if (selective_display)
{
break;
}
- set_iterator_to_next (it, 1);
+ set_iterator_to_next (it, true);
if (STRINGP (it->string))
it_charpos = IT_STRING_CHARPOS (*it);
else
}
produce_special_glyphs (it, IT_TRUNCATION);
}
- row->truncated_on_right_p = 1;
+ row->truncated_on_right_p = true;
}
break;
}
? WINDOW_RIGHT_FRINGE_WIDTH (it->w)
: WINDOW_LEFT_FRINGE_WIDTH (it->w)) == 0)
insert_left_trunc_glyphs (it);
- row->truncated_on_left_p = 1;
+ row->truncated_on_left_p = true;
}
it->face_id = saved_face_id;
and 1 if it's invisible and without an ellipsis. */
int
-invisible_p (register Lisp_Object propval, Lisp_Object list)
+invisible_prop (Lisp_Object propval, Lisp_Object list)
{
- register Lisp_Object tail, proptail;
+ Lisp_Object tail, proptail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
{
*/
-static int
+static bool
calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop,
- struct font *font, int width_p, int *align_to)
+ struct font *font, bool width_p, int *align_to)
{
double pixels;
-#define OK_PIXELS(val) ((*res = (double)(val)), 1)
-#define OK_ALIGN_TO(val) ((*align_to = (int)(val)), 1)
+# define OK_PIXELS(val) (*res = (val), true)
+# define OK_ALIGN_TO(val) (*align_to = (val), true)
if (NILP (prop))
return OK_PIXELS (0);
if (ppi > 0)
return OK_PIXELS (ppi / pixels);
- return 0;
+ return false;
}
}
return OK_PIXELS (width_p ? img->width : img->height);
}
-#ifdef HAVE_XWIDGETS
- if (FRAME_WINDOW_P (it->f) && valid_xwidget_spec_p (prop))
- {
- //TODO dont return dummy size
- return OK_PIXELS (width_p ? 100 : 100);
- }
-#endif
#endif
if (EQ (car, Qplus) || EQ (car, Qminus))
{
- int first = 1;
+ bool first = true;
double px;
pixels = 0;
{
if (!calc_pixel_width_or_height (&px, it, XCAR (cdr),
font, width_p, align_to))
- return 0;
+ return false;
if (first)
- pixels = (EQ (car, Qplus) ? px : -px), first = 0;
+ pixels = (EQ (car, Qplus) ? px : -px), first = false;
else
pixels += px;
cdr = XCDR (cdr);
if (calc_pixel_width_or_height (&fact, it, cdr,
font, width_p, align_to))
return OK_PIXELS (pixels * fact);
- return 0;
+ return false;
}
- return 0;
+ return false;
}
- return 0;
+ return false;
}
\f
/* Get face and two-byte form of character C in face FACE_ID on frame F.
- The encoding of C is returned in *CHAR2B. DISPLAY_P non-zero means
+ The encoding of C is returned in *CHAR2B. DISPLAY_P means
make sure that X resources for the face returned are allocated.
Value is a pointer to a realized face that is ready for display if
- DISPLAY_P is non-zero. */
+ DISPLAY_P. */
static struct face *
get_char_face_and_encoding (struct frame *f, int c, int face_id,
- XChar2b *char2b, int display_p)
+ XChar2b *char2b, bool display_p)
{
struct face *face = FACE_FROM_ID (f, face_id);
unsigned code = 0;
static struct face *
get_glyph_face_and_encoding (struct frame *f, struct glyph *glyph,
- XChar2b *char2b, int *two_byte_p)
+ XChar2b *char2b)
{
struct face *face;
unsigned code = 0;
eassert (face != NULL);
prepare_face_for_display (f, face);
- if (two_byte_p)
- *two_byte_p = 0;
-
if (face->font)
{
if (CHAR_BYTE8_P (glyph->u.ch))
/* Get glyph code of character C in FONT in the two-byte form CHAR2B.
- Return 1 if FONT has a glyph for C, otherwise return 0. */
+ Return true iff FONT has a glyph for C. */
-static int
+static bool
get_char_glyph_code (int c, struct font *font, XChar2b *char2b)
{
unsigned code;
code = font->driver->encode_char (font, c);
if (code == FONT_INVALID_CODE)
- return 0;
+ return false;
STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF));
- return 1;
+ return true;
}
-1, Qnil);
face = get_char_face_and_encoding (s->f, c, face_id,
- s->char2b + i, 1);
+ s->char2b + i, true);
if (face)
{
if (! s->face)
characters of the glyph string. */
if (s->font == NULL)
{
- s->font_not_found_p = 1;
+ s->font_not_found_p = true;
s->font = FRAME_FONT (s->f);
}
/* Adjust base line for subscript/superscript text. */
s->ybase += s->first_glyph->voffset;
- /* This glyph string must always be drawn with 16-bit functions. */
- s->two_byte_p = 1;
-
return s->cmp_to;
}
{
struct glyph *glyph, *last;
int voffset;
- int glyph_not_available_p;
+ bool glyph_not_available_p;
eassert (s->f == XFRAME (s->w->frame));
eassert (s->nchars == 0);
&& glyph->face_id == face_id
&& glyph->glyph_not_available_p == glyph_not_available_p)
{
- int two_byte_p;
-
s->face = get_glyph_face_and_encoding (s->f, glyph,
- s->char2b + s->nchars,
- &two_byte_p);
- s->two_byte_p = two_byte_p;
+ s->char2b + s->nchars);
++s->nchars;
eassert (s->nchars <= end - start);
s->width += glyph->pixel_width;
characters of the glyph string. */
if (s->font == NULL || glyph_not_available_p)
{
- s->font_not_found_p = 1;
+ s->font_not_found_p = true;
s->font = FRAME_FONT (s->f);
}
}
-#ifdef HAVE_XWIDGETS
-static void
-fill_xwidget_glyph_string (struct glyph_string *s)
-{
- eassert (s->first_glyph->type == XWIDGET_GLYPH);
- s->face = FACE_FROM_ID (s->f, s->first_glyph->face_id);
- s->font = s->face->font;
- s->width = s->first_glyph->pixel_width;
- s->ybase += s->first_glyph->voffset;
- s->xwidget = s->first_glyph->u.xwidget;
-}
-#endif
/* Fill glyph string S from a sequence of stretch glyphs.
START is the index of the first glyph to consider,
if (glyph->type == CHAR_GLYPH)
{
- struct face *face;
XChar2b char2b;
- struct font_metrics *pcm;
-
- face = get_glyph_face_and_encoding (f, glyph, &char2b, NULL);
- if (face->font && (pcm = get_per_char_metric (face->font, &char2b)))
+ struct face *face = get_glyph_face_and_encoding (f, glyph, &char2b);
+ if (face->font)
{
- if (pcm->rbearing > pcm->width)
- *right = pcm->rbearing - pcm->width;
- if (pcm->lbearing < 0)
- *left = -pcm->lbearing;
+ struct font_metrics *pcm = get_per_char_metric (face->font, &char2b);
+ if (pcm)
+ {
+ if (pcm->rbearing > pcm->width)
+ *right = pcm->rbearing - pcm->width;
+ if (pcm->lbearing < 0)
+ *left = -pcm->lbearing;
+ }
}
}
else if (glyph->type == COMPOSITE_GLYPH)
|| s->hl == DRAW_IMAGE_RAISED
|| s->hl == DRAW_IMAGE_SUNKEN))
|| s->hl == DRAW_MOUSE_FACE))
- s->extends_to_end_of_line_p = 1;
+ s->extends_to_end_of_line_p = true;
/* If S extends its face to the end of the line, set its
background_width to the distance to the right edge of the drawing
/* Compute overhangs and x-positions for glyph string S and its
predecessors, or successors. X is the starting x-position for S.
- BACKWARD_P non-zero means process predecessors. */
+ BACKWARD_P means process predecessors. */
static void
-compute_overhangs_and_x (struct glyph_string *s, int x, int backward_p)
+compute_overhangs_and_x (struct glyph_string *s, int x, bool backward_p)
{
if (backward_p)
{
append_glyph_string (&HEAD, &TAIL, s); \
s->x = (X); \
} \
- while (0)
+ while (false)
/* Add a glyph string for an image glyph to the list of strings
++START; \
s->x = (X); \
} \
- while (0)
-
-#ifdef HAVE_XWIDGETS
-#define BUILD_XWIDGET_GLYPH_STRING(START, END, HEAD, TAIL, HL, X, LAST_X) \
- do \
- { \
- s = (struct glyph_string *) alloca (sizeof *s); \
- INIT_GLYPH_STRING (s, NULL, w, row, area, START, HL); \
- fill_xwidget_glyph_string (s); \
- append_glyph_string (&HEAD, &TAIL, s); \
- ++START; \
- s->x = (X); \
- } \
- while (0)
-#endif
+ while (false)
/* Add a glyph string for a sequence of character glyphs to the list
s->x = (X); \
START = fill_glyph_string (s, face_id, START, END, overlaps); \
} \
- while (0)
+ while (false)
/* Add a glyph string for a composite sequence to the list of strings
\
++START; \
s = first_s; \
- } while (0)
+ } while (false)
/* Add a glyph string for a glyph-string sequence to the list of strings
append_glyph_string (&(HEAD), &(TAIL), s); \
s->x = (X); \
START = fill_gstring_glyph_string (s, face_id, START, END, overlaps); \
- } while (0)
+ } while (false)
/* Add a glyph string for a sequence of glyphless character's glyphs
START = fill_glyphless_glyph_string (s, face_id, START, END, \
overlaps); \
} \
- while (0)
+ while (false)
/* Build a list of glyph strings between HEAD and TAIL for the glyphs
to allocate glyph strings (because draw_glyphs can be called
asynchronously). */
-#define BUILD_GLYPH_STRINGS_1(START, END, HEAD, TAIL, HL, X, LAST_X) \
+#define BUILD_GLYPH_STRINGS(START, END, HEAD, TAIL, HL, X, LAST_X) \
do \
{ \
HEAD = TAIL = NULL; \
case IMAGE_GLYPH: \
BUILD_IMAGE_GLYPH_STRING (START, END, HEAD, TAIL, \
HL, X, LAST_X); \
- break;
-
-#define BUILD_GLYPH_STRINGS_XW(START, END, HEAD, TAIL, HL, X, LAST_X) \
- case XWIDGET_GLYPH: \
- BUILD_XWIDGET_GLYPH_STRING (START, END, HEAD, TAIL, \
- HL, X, LAST_X); \
- break;
-
-#define BUILD_GLYPH_STRINGS_2(START, END, HEAD, TAIL, HL, X, LAST_X) \
+ break; \
+ \
case GLYPHLESS_GLYPH: \
BUILD_GLYPHLESS_GLYPH_STRING (START, END, HEAD, TAIL, \
HL, X, LAST_X); \
(X) += s->width; \
} \
} \
- } while (0)
-
-
-#ifdef HAVE_XWIDGETS
-#define BUILD_GLYPH_STRINGS(START, END, HEAD, TAIL, HL, X, LAST_X) \
-BUILD_GLYPH_STRINGS_1(START, END, HEAD, TAIL, HL, X, LAST_X) \
-BUILD_GLYPH_STRINGS_XW(START, END, HEAD, TAIL, HL, X, LAST_X) \
-BUILD_GLYPH_STRINGS_2(START, END, HEAD, TAIL, HL, X, LAST_X)
-#else
-#define BUILD_GLYPH_STRINGS(START, END, HEAD, TAIL, HL, X, LAST_X) \
-BUILD_GLYPH_STRINGS_1(START, END, HEAD, TAIL, HL, X, LAST_X) \
-BUILD_GLYPH_STRINGS_2(START, END, HEAD, TAIL, HL, X, LAST_X)
-#endif
+ } while (false)
/* Draw glyphs between START and END in AREA of ROW on window W,
struct glyph_string *h, *t;
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
int mouse_beg_col IF_LINT (= 0), mouse_end_col IF_LINT (= 0);
- int check_mouse_face = 0;
+ bool check_mouse_face = false;
int dummy_x = 0;
/* If mouse highlighting is on, we may need to draw adjacent
if (row_vpos >= hlinfo->mouse_face_beg_row
&& row_vpos <= hlinfo->mouse_face_end_row)
{
- check_mouse_face = 1;
+ check_mouse_face = true;
mouse_beg_col = (row_vpos == hlinfo->mouse_face_beg_row)
? hlinfo->mouse_face_beg_col : 0;
mouse_end_col = (row_vpos == hlinfo->mouse_face_end_row)
BUILD_GLYPH_STRINGS (j, start, h, t,
overlap_hl, dummy_x, last_x);
start = i;
- compute_overhangs_and_x (t, head->x, 1);
+ compute_overhangs_and_x (t, head->x, true);
prepend_glyph_string_lists (&head, &tail, h, t);
if (clip_head == NULL)
clip_head = head;
BUILD_GLYPH_STRINGS (i, start, h, t,
overlap_hl, dummy_x, last_x);
for (s = h; s; s = s->next)
- s->background_filled_p = 1;
- compute_overhangs_and_x (t, head->x, 1);
+ s->background_filled_p = true;
+ compute_overhangs_and_x (t, head->x, true);
prepend_glyph_string_lists (&head, &tail, h, t);
}
overlap_hl, x, last_x);
/* Because BUILD_GLYPH_STRINGS updates the first argument,
we don't have `end = i;' here. */
- compute_overhangs_and_x (h, tail->x + tail->width, 0);
+ compute_overhangs_and_x (h, tail->x + tail->width, false);
append_glyph_string_lists (&head, &tail, h, t);
if (clip_tail == NULL)
clip_tail = tail;
BUILD_GLYPH_STRINGS (end, i, h, t,
overlap_hl, x, last_x);
for (s = h; s; s = s->next)
- s->background_filled_p = 1;
- compute_overhangs_and_x (h, tail->x + tail->width, 0);
+ s->background_filled_p = true;
+ compute_overhangs_and_x (h, tail->x + tail->width, false);
append_glyph_string_lists (&head, &tail, h, t);
}
if (clip_head || clip_tail)
FRAME_RIF (f)->draw_glyph_string (s);
#ifndef HAVE_NS
- /* When focus a sole frame and move horizontally, this sets on_p to 0
+ /* When focus a sole frame and move horizontally, this clears on_p
causing a failure to erase prev cursor position. */
if (area == TEXT_AREA
&& !row->full_width_p
< it->glyph_row->glyphs[area + 1])) \
{ \
it->w->ncols_scale_factor++; \
- it->f->fonts_changed = 1; \
+ it->f->fonts_changed = true; \
} \
}
if (it->pixel_width > 0)
{
glyph->pixel_width = it->pixel_width;
- glyph->padding_p = 0;
+ glyph->padding_p = false;
}
else
{
/* Assure at least 1-pixel width. Otherwise, cursor can't
be displayed correctly. */
glyph->pixel_width = 1;
- glyph->padding_p = 1;
+ glyph->padding_p = true;
}
glyph->ascent = it->ascent;
glyph->descent = it->descent;
glyph->type = COMPOSITE_GLYPH;
if (it->cmp_it.ch < 0)
{
- glyph->u.cmp.automatic = 0;
+ glyph->u.cmp.automatic = false;
glyph->u.cmp.id = it->cmp_it.id;
glyph->slice.cmp.from = glyph->slice.cmp.to = 0;
}
else
{
- glyph->u.cmp.automatic = 1;
+ glyph->u.cmp.automatic = true;
glyph->u.cmp.id = it->cmp_it.id;
glyph->slice.cmp.from = it->cmp_it.from;
glyph->slice.cmp.to = it->cmp_it.to - 1;
}
glyph->overlaps_vertically_p = (it->phys_ascent > it->ascent
|| it->phys_descent > it->descent);
- glyph->padding_p = 0;
- glyph->glyph_not_available_p = 0;
+ glyph->padding_p = false;
+ glyph->glyph_not_available_p = false;
glyph->face_id = it->face_id;
glyph->font_type = FONT_TYPE_UNKNOWN;
if (it->bidi_p)
glyph->left_box_line_p = it->start_of_box_run_p;
glyph->right_box_line_p = it->end_of_box_run_p;
}
- glyph->overlaps_vertically_p = 0;
- glyph->padding_p = 0;
- glyph->glyph_not_available_p = 0;
+ glyph->overlaps_vertically_p = false;
+ glyph->padding_p = false;
+ glyph->glyph_not_available_p = false;
glyph->face_id = it->face_id;
glyph->u.img_id = img->id;
glyph->slice.img = slice;
}
}
-#ifdef HAVE_XWIDGETS
-static void
-produce_xwidget_glyph (struct it *it)
-{
- struct xwidget* xw;
- struct face *face;
- int glyph_ascent, crop;
- eassert (it->what == IT_XWIDGET);
-
- face = FACE_FROM_ID (it->f, it->face_id);
- eassert (face);
- /* Make sure X resources of the face is loaded. */
- prepare_face_for_display (it->f, face);
-
- xw = it->xwidget;
- it->ascent = it->phys_ascent = glyph_ascent = xw->height/2;
- it->descent = xw->height/2;
- it->phys_descent = it->descent;
- it->pixel_width = xw->width;
- /* It's quite possible for images to have an ascent greater than
- their height, so don't get confused in that case. */
- if (it->descent < 0)
- it->descent = 0;
-
- it->nglyphs = 1;
-
- if (face->box != FACE_NO_BOX)
- {
- if (face->box_line_width > 0)
- {
- it->ascent += face->box_line_width;
- it->descent += face->box_line_width;
- }
-
- if (it->start_of_box_run_p)
- it->pixel_width += eabs (face->box_line_width);
- it->pixel_width += eabs (face->box_line_width);
- }
-
- take_vertical_position_into_account (it);
-
- /* Automatically crop wide image glyphs at right edge so we can
- draw the cursor on same display row. */
- if ((crop = it->pixel_width - (it->last_visible_x - it->current_x), crop > 0)
- && (it->hpos == 0 || it->pixel_width > it->last_visible_x / 4))
- {
- it->pixel_width -= crop;
- }
-
- if (it->glyph_row)
- {
- struct glyph *glyph;
- enum glyph_row_area area = it->area;
-
- glyph = it->glyph_row->glyphs[area] + it->glyph_row->used[area];
- if (it->glyph_row->reversed_p)
- {
- struct glyph *g;
-
- /* Make room for the new glyph. */
- for (g = glyph - 1; g >= it->glyph_row->glyphs[it->area]; g--)
- g[1] = *g;
- glyph = it->glyph_row->glyphs[it->area];
- }
- if (glyph < it->glyph_row->glyphs[area + 1])
- {
- glyph->charpos = CHARPOS (it->position);
- glyph->object = it->object;
- glyph->pixel_width = it->pixel_width;
- glyph->ascent = glyph_ascent;
- glyph->descent = it->descent;
- glyph->voffset = it->voffset;
- glyph->type = XWIDGET_GLYPH;
- glyph->avoid_cursor_p = it->avoid_cursor_p;
- glyph->multibyte_p = it->multibyte_p;
- if (it->glyph_row->reversed_p && area == TEXT_AREA)
- {
- /* In R2L rows, the left and the right box edges need to be
- drawn in reverse direction. */
- glyph->right_box_line_p = it->start_of_box_run_p;
- glyph->left_box_line_p = it->end_of_box_run_p;
- }
- else
- {
- glyph->left_box_line_p = it->start_of_box_run_p;
- glyph->right_box_line_p = it->end_of_box_run_p;
- }
- glyph->overlaps_vertically_p = 0;
- glyph->padding_p = 0;
- glyph->glyph_not_available_p = 0;
- glyph->face_id = it->face_id;
- glyph->u.xwidget = it->xwidget;
- //assert_valid_xwidget_id(glyph->u.xwidget_id,"produce_xwidget_glyph");
- glyph->font_type = FONT_TYPE_UNKNOWN;
- if (it->bidi_p)
- {
- glyph->resolved_level = it->bidi_it.resolved_level;
- eassert ((it->bidi_it.type & 7) == it->bidi_it.type);
- glyph->bidi_type = it->bidi_it.type;
- }
- ++it->glyph_row->used[area];
- }
- else
- IT_EXPAND_MATRIX_WIDTH (it, area);
- }
-}
-#endif
/* Append a stretch glyph to IT->glyph_row. OBJECT is the source
of the glyph, WIDTH and HEIGHT are the width and height of the
glyph->left_box_line_p = it->start_of_box_run_p;
glyph->right_box_line_p = it->end_of_box_run_p;
}
- glyph->overlaps_vertically_p = 0;
- glyph->padding_p = 0;
- glyph->glyph_not_available_p = 0;
+ glyph->overlaps_vertically_p = false;
+ glyph->padding_p = false;
+ glyph->glyph_not_available_p = false;
glyph->face_id = it->face_id;
glyph->u.stretch.ascent = ascent;
glyph->u.stretch.height = height;
/* (space :width WIDTH :height HEIGHT ...) */
Lisp_Object prop, plist;
int width = 0, height = 0, align_to = -1;
- int zero_width_ok_p = 0;
+ bool zero_width_ok_p = false;
double tem;
struct font *font = NULL;
#ifdef HAVE_WINDOW_SYSTEM
int ascent = 0;
- int zero_height_ok_p = 0;
+ bool zero_height_ok_p = false;
if (FRAME_WINDOW_P (it->f))
{
/* Compute the width of the stretch. */
if ((prop = Fplist_get (plist, QCwidth), !NILP (prop))
- && calc_pixel_width_or_height (&tem, it, prop, font, 1, 0))
+ && calc_pixel_width_or_height (&tem, it, prop, font, true, 0))
{
/* Absolute width `:width WIDTH' specified and valid. */
- zero_width_ok_p = 1;
+ zero_width_ok_p = true;
width = (int)tem;
}
#ifdef HAVE_WINDOW_SYSTEM
}
#endif /* HAVE_WINDOW_SYSTEM */
else if ((prop = Fplist_get (plist, QCalign_to), !NILP (prop))
- && calc_pixel_width_or_height (&tem, it, prop, font, 1, &align_to))
+ && calc_pixel_width_or_height (&tem, it, prop, font, true,
+ &align_to))
{
if (it->glyph_row == NULL || !it->glyph_row->mode_line_p)
align_to = (align_to < 0
else if (align_to < 0)
align_to = window_box_left_offset (it->w, TEXT_AREA);
width = max (0, (int)tem + align_to - it->current_x);
- zero_width_ok_p = 1;
+ zero_width_ok_p = true;
}
else
/* Nothing specified -> width defaults to canonical char width. */
if (FRAME_WINDOW_P (it->f))
{
if ((prop = Fplist_get (plist, QCheight), !NILP (prop))
- && calc_pixel_width_or_height (&tem, it, prop, font, 0, 0))
+ && calc_pixel_width_or_height (&tem, it, prop, font, false, 0))
{
height = (int)tem;
- zero_height_ok_p = 1;
+ zero_height_ok_p = true;
}
else if (prop = Fplist_get (plist, QCrelative_height),
NUMVAL (prop) > 0)
NUMVAL (prop) > 0 && NUMVAL (prop) <= 100)
ascent = height * NUMVAL (prop) / 100.0;
else if (!NILP (prop)
- && calc_pixel_width_or_height (&tem, it, prop, font, 0, 0))
+ && calc_pixel_width_or_height (&tem, it, prop, font, false, 0))
ascent = min (max (0, (int)tem), height);
else
ascent = (height * FONT_BASE (font)) / FONT_HEIGHT (font);
{
it->ascent = it->phys_ascent = ascent;
it->descent = it->phys_descent = height - it->ascent;
- it->nglyphs = width > 0 && height > 0 ? 1 : 0;
+ it->nglyphs = width > 0 && height > 0;
take_vertical_position_into_account (it);
}
else
Returns height in pixels, or nil. */
-
static Lisp_Object
calc_line_height_property (struct it *it, Lisp_Object val, struct font *font,
- int boff, int override)
+ int boff, bool override)
{
Lisp_Object face_name = Qnil;
int ascent, descent, height;
}
else if (EQ (face_name, Qt))
{
- override = 0;
+ override = false;
}
else
{
/* Append a glyph for a glyphless character to IT->glyph_row. FACE_ID
- is a face ID to be used for the glyph. FOR_NO_FONT is nonzero if
+ is a face ID to be used for the glyph. FOR_NO_FONT is true if
and only if this is for a character for which no font was found.
If the display method (it->glyphless_method) is
For the other display methods, LEN through LOWER_YOFF are zero. */
static void
-append_glyphless_glyph (struct it *it, int face_id, int for_no_font, int len,
+append_glyphless_glyph (struct it *it, int face_id, bool for_no_font, int len,
short upper_xoff, short upper_yoff,
short lower_xoff, short lower_yoff)
{
}
glyph->overlaps_vertically_p = (it->phys_ascent > it->ascent
|| it->phys_descent > it->descent);
- glyph->padding_p = 0;
- glyph->glyph_not_available_p = 0;
+ glyph->padding_p = false;
+ glyph->glyph_not_available_p = false;
glyph->face_id = face_id;
glyph->font_type = FONT_TYPE_UNKNOWN;
if (it->bidi_p)
the character. See the description of enum
glyphless_display_method in dispextern.h for the detail.
- FOR_NO_FONT is nonzero if and only if this is for a character for
+ FOR_NO_FONT is true if and only if this is for a character for
which no font was found. ACRONYM, if non-nil, is an acronym string
for the character. */
static void
-produce_glyphless_glyph (struct it *it, int for_no_font, Lisp_Object acronym)
+produce_glyphless_glyph (struct it *it, bool for_no_font, Lisp_Object acronym)
{
int face_id;
struct face *face;
{
int extra_line_spacing = it->extra_line_spacing;
- it->glyph_not_available_p = 0;
+ it->glyph_not_available_p = false;
if (it->what == IT_CHARACTER)
{
Lisp_Object acronym = lookup_glyphless_char_display (-1, it);
eassert (it->what == IT_GLYPHLESS);
- produce_glyphless_glyph (it, 1, STRINGP (acronym) ? acronym : Qnil);
+ produce_glyphless_glyph (it, true,
+ STRINGP (acronym) ? acronym : Qnil);
goto done;
}
if (it->char_to_display != '\n' && it->char_to_display != '\t')
{
- int stretched_p;
-
it->nglyphs = 1;
if (it->override_ascent >= 0)
}
else
{
- it->glyph_not_available_p = 1;
+ it->glyph_not_available_p = true;
it->phys_ascent = it->ascent;
it->phys_descent = it->descent;
it->pixel_width = font->space_width;
/* If this is a space inside a region of text with
`space-width' property, change its width. */
- stretched_p = it->char_to_display == ' ' && !NILP (it->space_width);
+ bool stretched_p
+ = it->char_to_display == ' ' && !NILP (it->space_width);
if (stretched_p)
it->pixel_width *= XFLOATINT (it->space_width);
in this line, record that fact in a flag of the
glyph row. This is used to optimize X output code. */
if (pcm && (pcm->lbearing < 0 || pcm->rbearing > pcm->width))
- it->glyph_row->contains_overlapping_glyphs_p = 1;
+ it->glyph_row->contains_overlapping_glyphs_p = true;
}
if (! stretched_p && it->pixel_width == 0)
/* We assure that all visible glyphs have at least 1-pixel
total_height = XCAR (XCDR (height));
height = XCAR (height);
}
- height = calc_line_height_property (it, height, font, boff, 1);
+ height = calc_line_height_property (it, height, font, boff, true);
if (it->override_ascent >= 0)
{
}
it->phys_ascent = min (it->phys_ascent, it->ascent);
it->phys_descent = min (it->phys_descent, it->descent);
- it->constrain_row_ascent_descent_p = 1;
+ it->constrain_row_ascent_descent_p = true;
extra_line_spacing = 0;
}
else
it->ascent = XINT (height) - it->descent;
if (!NILP (total_height))
- spacing = calc_line_height_property (it, total_height, font, boff, 0);
+ spacing = calc_line_height_property (it, total_height, font,
+ boff, false);
else
{
spacing = get_it_property (it, Qline_spacing);
- spacing = calc_line_height_property (it, spacing, font, boff, 0);
+ spacing = calc_line_height_property (it, spacing, font,
+ boff, false);
}
if (INTEGERP (spacing))
{
int leftmost, rightmost, lowest, highest;
int lbearing, rbearing;
int i, width, ascent, descent;
- int left_padded = 0, right_padded = 0;
int c IF_LINT (= 0); /* cmp->glyph_len can't be zero; see Bug#8512 */
XChar2b char2b;
struct font_metrics *pcm;
- int font_not_found_p;
ptrdiff_t pos;
for (glyph_len = cmp->glyph_len; glyph_len > 0; glyph_len--)
if ((c = COMPOSITION_GLYPH (cmp, glyph_len - 1)) != '\t')
break;
- if (glyph_len < cmp->glyph_len)
- right_padded = 1;
+ bool right_padded = glyph_len < cmp->glyph_len;
for (i = 0; i < glyph_len; i++)
{
if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t')
break;
cmp->offsets[i * 2] = cmp->offsets[i * 2 + 1] = 0;
}
- if (i > 0)
- left_padded = 1;
+ bool left_padded = i > 0;
pos = (STRINGP (it->string) ? IT_STRING_CHARPOS (*it)
: IT_CHARPOS (*it));
/* If no suitable font is found, use the default font. */
- font_not_found_p = font == NULL;
+ bool font_not_found_p = font == NULL;
if (font_not_found_p)
{
face = face->ascii_face;
if (! font_not_found_p)
{
get_char_face_and_encoding (it->f, c, it->face_id,
- &char2b, 0);
+ &char2b, false);
pcm = get_per_char_metric (font, &char2b);
}
else
{
get_char_face_and_encoding (it->f, ch, face_id,
- &char2b, 0);
+ &char2b, false);
pcm = get_per_char_metric (font, &char2b);
}
if (! pcm)
if (it->glyph_row
&& (cmp->lbearing < 0
|| cmp->rbearing > cmp->pixel_width))
- it->glyph_row->contains_overlapping_glyphs_p = 1;
+ it->glyph_row->contains_overlapping_glyphs_p = true;
it->pixel_width = cmp->pixel_width;
it->ascent = it->phys_ascent = cmp->ascent;
&metrics);
if (it->glyph_row
&& (metrics.lbearing < 0 || metrics.rbearing > metrics.width))
- it->glyph_row->contains_overlapping_glyphs_p = 1;
+ it->glyph_row->contains_overlapping_glyphs_p = true;
it->ascent = it->phys_ascent = metrics.ascent;
it->descent = it->phys_descent = metrics.descent;
if (face->box != FACE_NO_BOX)
append_composite_glyph (it);
}
else if (it->what == IT_GLYPHLESS)
- produce_glyphless_glyph (it, 0, Qnil);
+ produce_glyphless_glyph (it, false, Qnil);
else if (it->what == IT_IMAGE)
produce_image_glyph (it);
else if (it->what == IT_STRETCH)
produce_stretch_glyph (it);
-#ifdef HAVE_XWIDGETS
- else if (it->what == IT_XWIDGET)
- produce_xwidget_glyph (it);
-#endif
done:
/* Accumulate dimensions. Note: can't assume that it->descent > 0
&& w->phys_cursor.vpos == w->output_cursor.vpos
&& chpos >= hpos
&& chpos < hpos + len)
- w->phys_cursor_on_p = 0;
+ w->phys_cursor_on_p = false;
unblock_input ();
FRAME_BLINK_OFF_CURSOR (f) = DEFAULT_CURSOR;
/* Make sure the cursor gets redrawn. */
- f->cursor_type_changed = 1;
+ f->cursor_type_changed = true;
}
/* Return the cursor we want to be displayed in window W. Return
width of bar/hbar cursor through WIDTH arg. Return with
- ACTIVE_CURSOR arg set to 1 if cursor in window W is `active'
+ ACTIVE_CURSOR arg set to true if cursor in window W is `active'
(i.e. if the `system caret' should track this cursor).
In a mini-buffer window, we want the cursor only to appear if we
static enum text_cursor_kinds
get_window_cursor_type (struct window *w, struct glyph *glyph, int *width,
- int *active_cursor)
+ bool *active_cursor)
{
struct frame *f = XFRAME (w->frame);
struct buffer *b = XBUFFER (w->contents);
int cursor_type = DEFAULT_CURSOR;
Lisp_Object alt_cursor;
- int non_selected = 0;
+ bool non_selected = false;
- *active_cursor = 1;
+ *active_cursor = true;
/* Echo area */
if (cursor_in_echo_area
return get_specified_cursor_type (BVAR (b, cursor_type), width);
}
- *active_cursor = 0;
- non_selected = 1;
+ *active_cursor = false;
+ non_selected = true;
}
/* Detect a nonselected window or nonselected frame. */
else if (w != XWINDOW (f->selected_window)
|| f != FRAME_DISPLAY_INFO (f)->x_highlight_frame)
{
- *active_cursor = 0;
+ *active_cursor = false;
if (MINI_WINDOW_P (w) && minibuf_level == 0)
return NO_CURSOR;
- non_selected = 1;
+ non_selected = true;
}
/* Never display a cursor in a window in which cursor-type is nil. */
/* Use normal cursor if not blinked off. */
if (!w->cursor_off_p)
{
-
-#ifdef HAVE_XWIDGETS
- if (glyph != NULL && glyph->type == XWIDGET_GLYPH){
- return NO_CURSOR;
- }
-#endif
if (glyph != NULL && glyph->type == IMAGE_GLYPH)
{
if (cursor_type == FILLED_BOX_CURSOR)
return FRAME_BLINK_OFF_CURSOR (f);
}
-#if 0
+#if false
/* Some people liked having a permanently visible blinking cursor,
while others had very strong opinions against it. So it was
decided to remove it. KFS 2003-09-03 */
if (row->cursor_in_fringe_p)
{
- row->cursor_in_fringe_p = 0;
+ row->cursor_in_fringe_p = false;
draw_fringe_bitmap (w, row, row->reversed_p);
- w->phys_cursor_on_p = 0;
+ w->phys_cursor_on_p = false;
return;
}
if ((y0 < cy0 || y0 >= cy1) && (y1 <= cy0 || y1 >= cy1))
return;
- w->phys_cursor_on_p = 0;
+ w->phys_cursor_on_p = false;
}
#endif /* HAVE_WINDOW_SYSTEM */
? (w->phys_cursor.hpos >= 0)
: (w->phys_cursor.hpos < row->used[TEXT_AREA])))
{
- int on_p = w->phys_cursor_on_p;
+ bool on_p = w->phys_cursor_on_p;
int x1;
int hpos = w->phys_cursor.hpos;
Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f);
int hpos = w->phys_cursor.hpos;
int vpos = w->phys_cursor.vpos;
- int mouse_face_here_p = 0;
+ bool mouse_face_here_p = false;
struct glyph_matrix *active_glyphs = w->current_matrix;
struct glyph_row *cursor_row;
struct glyph *cursor_glyph;
/* If cursor is in the fringe, erase by drawing actual bitmap there. */
if (cursor_row->cursor_in_fringe_p)
{
- cursor_row->cursor_in_fringe_p = 0;
+ cursor_row->cursor_in_fringe_p = false;
draw_fringe_bitmap (w, cursor_row, cursor_row->reversed_p);
goto mark_cursor_off;
}
end of a line (on a newline). The cursor appears there, but
mouse highlighting does not. */
&& cursor_row->used[TEXT_AREA] > hpos && hpos >= 0)
- mouse_face_here_p = 1;
+ mouse_face_here_p = true;
/* Maybe clear the display under the cursor. */
if (w->phys_cursor_type == HOLLOW_BOX_CURSOR)
draw_phys_cursor_glyph (w, cursor_row, hl);
mark_cursor_off:
- w->phys_cursor_on_p = 0;
+ w->phys_cursor_on_p = false;
w->phys_cursor_type = NO_CURSOR;
}
-/* EXPORT:
- Display or clear cursor of window W. If ON is zero, clear the
- cursor. If it is non-zero, display the cursor. If ON is nonzero,
- where to put the cursor is specified by HPOS, VPOS, X and Y. */
+/* Display or clear cursor of window W. If !ON, clear the cursor.
+ If ON, display the cursor; where to put the cursor is specified by
+ HPOS, VPOS, X and Y. */
void
display_and_set_cursor (struct window *w, bool on,
struct frame *f = XFRAME (w->frame);
int new_cursor_type;
int new_cursor_width;
- int active_cursor;
+ bool active_cursor;
struct glyph_row *glyph_row;
struct glyph *glyph;
display the cursor. */
if (!glyph_row->enabled_p)
{
- w->phys_cursor_on_p = 0;
+ w->phys_cursor_on_p = false;
return;
}
erase_phys_cursor (w);
/* Don't check phys_cursor_on_p here because that flag is only set
- to zero in some cases where we know that the cursor has been
+ to false in some cases where we know that the cursor has been
completely erased, to avoid the extra work of erasing the cursor
- twice. In other words, phys_cursor_on_p can be 1 and the cursor
+ twice. In other words, phys_cursor_on_p can be true and the cursor
still not be visible, or it has only been partly erased. */
if (on)
{
x_clear_cursor (struct window *w)
{
if (FRAME_VISIBLE_P (XFRAME (w->frame)) && w->phys_cursor_on_p)
- update_window_cursor (w, 0);
+ update_window_cursor (w, false);
}
#endif /* HAVE_WINDOW_SYSTEM */
anymore. This can happen when a window is split. */
&& hlinfo->mouse_face_end_row < w->current_matrix->nrows)
{
- int phys_cursor_on_p = w->phys_cursor_on_p;
+ bool phys_cursor_on_p = w->phys_cursor_on_p;
struct glyph_row *row, *first, *last;
first = MATRIX_ROW (w->current_matrix, hlinfo->mouse_face_beg_row);
{
end_hpos = row->used[TEXT_AREA];
if (draw == DRAW_NORMAL_TEXT)
- row->fill_line_p = 1; /* Clear to end of line */
+ row->fill_line_p = true; /* Clear to end of line. */
}
}
else if (row->reversed_p && row == first)
{
end_hpos = row->used[TEXT_AREA];
if (draw == DRAW_NORMAL_TEXT)
- row->fill_line_p = 1; /* Clear to end of line */
+ row->fill_line_p = true; /* Clear to end of line. */
}
if (end_hpos > start_hpos)
hpos = row->used[TEXT_AREA] - 1;
block_input ();
- display_and_set_cursor (w, 1, hpos, w->phys_cursor.vpos,
+ display_and_set_cursor (w, true, hpos, w->phys_cursor.vpos,
w->phys_cursor.x, w->phys_cursor.y);
unblock_input ();
}
/* EXPORT:
Clear out the mouse-highlighted active region.
- Redraw it un-highlighted first. Value is non-zero if mouse
+ Redraw it un-highlighted first. Value is true if mouse
face was actually drawn unhighlighted. */
-int
+bool
clear_mouse_face (Mouse_HLInfo *hlinfo)
{
- int cleared = 0;
-
- if (!hlinfo->mouse_face_hidden && !NILP (hlinfo->mouse_face_window))
- {
- show_mouse_face (hlinfo, DRAW_NORMAL_TEXT);
- cleared = 1;
- }
-
+ bool cleared
+ = !hlinfo->mouse_face_hidden && !NILP (hlinfo->mouse_face_window);
+ if (cleared)
+ show_mouse_face (hlinfo, DRAW_NORMAL_TEXT);
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_window = Qnil;
if (r2 == NULL)
{
r2 = MATRIX_ROW (w->current_matrix, w->window_end_vpos);
- hlinfo->mouse_face_past_end = 1;
+ hlinfo->mouse_face_past_end = true;
}
else if (!NILP (after_string))
{
mouse_face_from_string_pos), but I leave it here for the time
being, in case someone would. */
-#if 0 /* not used */
+#if false /* not used */
/* Find the position of the glyph for position POS in OBJECT in
window W's current matrix, and return in *X, *Y the pixel
coordinates, and return in *HPOS, *VPOS the column/row of the glyph.
- RIGHT_P non-zero means return the position of the right edge of the
- glyph, RIGHT_P zero means return the left edge position.
+ RIGHT_P means return the position of the right edge of the glyph.
+ !RIGHT_P means return the left edge position.
If no glyph for POS exists in the matrix, return the position of
the glyph with the next smaller position that is in the matrix, if
- RIGHT_P is zero. If RIGHT_P is non-zero, and no glyph for POS
+ RIGHT_P is false. If RIGHT_P, and no glyph for POS
exists in the matrix, return the position of the glyph with the
next larger position in OBJECT.
- Value is non-zero if a glyph was found. */
+ Value is true if a glyph was found. */
-static int
+static bool
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 *hpos, int *vpos, int *x, int *y, bool right_p)
{
int yb = window_text_bottom_y (w);
struct glyph_row *r;
struct glyph_row *r;
struct glyph *g, *e;
int gx;
- int found = 0;
+ bool found = false;
/* Find the glyph row with at least one position in the range
[STARTPOS..ENDPOS), and the first glyph in that row whose
= MATRIX_ROW_VPOS (r, w->current_matrix);
hlinfo->mouse_face_beg_col = g - r->glyphs[TEXT_AREA];
hlinfo->mouse_face_beg_x = gx;
- found = 1;
+ found = true;
break;
}
}
for (gx = r->x, g1 = r->glyphs[TEXT_AREA]; g1 < g; ++g1)
gx += g1->pixel_width;
hlinfo->mouse_face_beg_x = gx;
- found = 1;
+ found = true;
break;
}
}
{
g = r->glyphs[TEXT_AREA];
e = g + r->used[TEXT_AREA];
- found = 0;
+ found = false;
for ( ; g < e; ++g)
if (EQ (g->object, object)
&& startpos <= g->charpos && g->charpos < endpos)
{
- found = 1;
+ found = true;
break;
}
if (!found)
/* See if position X, Y is within a hot-spot of an image. */
-static int
+static bool
on_hot_spot_p (Lisp_Object hot_spot, int x, int y)
{
if (!CONSP (hot_spot))
- return 0;
+ return false;
if (EQ (XCAR (hot_spot), Qrect))
{
Lisp_Object rect = XCDR (hot_spot);
Lisp_Object tem;
if (!CONSP (rect))
- return 0;
+ return false;
if (!CONSP (XCAR (rect)))
- return 0;
+ return false;
if (!CONSP (XCDR (rect)))
- return 0;
+ return false;
if (!(tem = XCAR (XCAR (rect)), INTEGERP (tem) && x >= XINT (tem)))
- return 0;
+ return false;
if (!(tem = XCDR (XCAR (rect)), INTEGERP (tem) && y >= XINT (tem)))
- return 0;
+ return false;
if (!(tem = XCAR (XCDR (rect)), INTEGERP (tem) && x <= XINT (tem)))
- return 0;
+ return false;
if (!(tem = XCDR (XCDR (rect)), INTEGERP (tem) && y <= XINT (tem)))
- return 0;
- return 1;
+ return false;
+ return true;
}
else if (EQ (XCAR (hot_spot), Qcircle))
{
Lisp_Object *poly = v->contents;
ptrdiff_t n = v->header.size;
ptrdiff_t i;
- int inside = 0;
+ bool inside = false;
Lisp_Object lx, ly;
int x0, y0;
/* Need an even number of coordinates, and at least 3 edges. */
if (n < 6 || n & 1)
- return 0;
+ return false;
/* Count edge segments intersecting line from (X,Y) to (X,infinity).
If count is odd, we are inside polygon. Pixels on edges
polygon. */
if ((lx = poly[n-2], !INTEGERP (lx))
|| (ly = poly[n-1], !INTEGERP (lx)))
- return 0;
+ return false;
x0 = XINT (lx), y0 = XINT (ly);
for (i = 0; i < n; i += 2)
{
int x1 = x0, y1 = y0;
if ((lx = poly[i], !INTEGERP (lx))
|| (ly = poly[i+1], !INTEGERP (ly)))
- return 0;
+ return false;
x0 = XINT (lx), y0 = XINT (ly);
/* Does this segment cross the X line? */
return inside;
}
}
- return 0;
+ return false;
}
Lisp_Object
hlinfo->mouse_face_beg_row = vpos;
hlinfo->mouse_face_end_row = hlinfo->mouse_face_beg_row;
- hlinfo->mouse_face_past_end = 0;
+ hlinfo->mouse_face_past_end = false;
hlinfo->mouse_face_window = window;
hlinfo->mouse_face_face_id = face_at_string_position (w, string,
return;
/* Which window is that in? */
- window = window_from_coordinates (f, x, y, &part, 1);
+ window = window_from_coordinates (f, x, y, &part, true);
/* If displaying active text in another window, clear that. */
if (! EQ (window, hlinfo->mouse_face_window)
ptrdiff_t i, noverlays;
struct buffer *obuf;
ptrdiff_t obegv, ozv;
- int same_region;
+ bool same_region;
/* Find the glyph under X/Y. */
glyph = x_y_to_hpos_vpos (w, x, y, &hpos, &vpos, &dx, &dy, &area);
if (BUFFERP (object))
{
/* Put all the overlays we want in a vector in overlay_vec. */
- GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, 0);
+ GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, false);
/* Sort overlays into increasing priority order. */
noverlays = sort_overlays (overlay_vec, noverlays, w);
}
e = make_number (SCHARS (object));
mouse_face_from_string_pos (w, hlinfo, object,
XINT (s), XINT (e));
- hlinfo->mouse_face_past_end = 0;
+ hlinfo->mouse_face_past_end = false;
hlinfo->mouse_face_window = window;
hlinfo->mouse_face_face_id
= face_at_string_position (w, object, pos, 0, &ignore,
/* Redraw the parts of the glyph row ROW on window W intersecting
rectangle R. R is in window-relative coordinates. Value is
- non-zero if mouse-face was overwritten. */
+ true if mouse-face was overwritten. */
-static int
+static bool
expose_line (struct window *w, struct glyph_row *row, XRectangle *r)
{
eassert (row->enabled_p);
}
-/* Return non-zero if W's cursor intersects rectangle R. */
+/* Return true if W's cursor intersects rectangle R. */
-static int
+static bool
phys_cursor_in_rect_p (struct window *w, XRectangle *r)
{
XRectangle cr, result;
return x_intersect_rectangles (&cr, r, &result);
}
/* If we don't understand the format, pretend we're not in the hot-spot. */
- return 0;
+ return false;
}
/* Redraw the part of window W intersection rectangle FR. Pixel
coordinates in FR are frame-relative. Call this function with
- input blocked. Value is non-zero if the exposure overwrites
+ input blocked. Value is true if the exposure overwrites
mouse-face. */
-static int
+static bool
expose_window (struct window *w, XRectangle *fr)
{
struct frame *f = XFRAME (w->frame);
XRectangle wr, r;
- int mouse_face_overwritten_p = 0;
+ bool mouse_face_overwritten_p = false;
/* If window is not yet fully initialized, do nothing. This can
happen when toolkit scroll bars are used and a window is split.
Reconfiguring the scroll bar will generate an expose for a newly
created window. */
if (w->current_matrix == NULL)
- return 0;
+ return false;
/* When we're currently updating the window, display and current
matrix usually don't agree. Arrange for a thorough display
if (w->must_be_updated_p)
{
SET_FRAME_GARBAGED (f);
- return 0;
+ return false;
}
/* Frame-relative pixel rectangle of W. */
{
int yb = window_text_bottom_y (w);
struct glyph_row *row;
- int cursor_cleared_p, phys_cursor_on_p;
struct glyph_row *first_overlapping_row, *last_overlapping_row;
TRACE ((stderr, "expose_window (%d, %d, %d, %d)\n",
r.y -= WINDOW_TOP_EDGE_Y (w);
/* Turn off the cursor. */
- if (!w->pseudo_window_p
- && phys_cursor_in_rect_p (w, &r))
- {
- x_clear_cursor (w);
- cursor_cleared_p = 1;
- }
- else
- cursor_cleared_p = 0;
+ bool cursor_cleared_p = (!w->pseudo_window_p
+ && phys_cursor_in_rect_p (w, &r));
+ if (cursor_cleared_p)
+ x_clear_cursor (w);
/* If the row containing the cursor extends face to end of line,
then expose_area might overwrite the cursor outside the
rectangle and thus notice_overwritten_cursor might clear
w->phys_cursor_on_p. We remember the original value and
check later if it is changed. */
- phys_cursor_on_p = w->phys_cursor_on_p;
+ bool phys_cursor_on_p = w->phys_cursor_on_p;
/* Update lines intersecting rectangle R. */
first_overlapping_row = last_overlapping_row = NULL;
row->clip = fr;
if (expose_line (w, row, &r))
- mouse_face_overwritten_p = 1;
+ mouse_face_overwritten_p = true;
row->clip = NULL;
}
else if (row->overlapping_p)
&& row->y < r.y + r.height)
{
if (expose_line (w, row, &r))
- mouse_face_overwritten_p = 1;
+ mouse_face_overwritten_p = true;
}
if (!w->pseudo_window_p)
/* Turn the cursor on again. */
if (cursor_cleared_p
|| (phys_cursor_on_p && !w->phys_cursor_on_p))
- update_window_cursor (w, 1);
+ update_window_cursor (w, true);
}
}
/* Redraw (parts) of all windows in the window tree rooted at W that
intersect R. R contains frame pixel coordinates. Value is
- non-zero if the exposure overwrites mouse-face. */
+ true if the exposure overwrites mouse-face. */
-static int
+static bool
expose_window_tree (struct window *w, XRectangle *r)
{
struct frame *f = XFRAME (w->frame);
- int mouse_face_overwritten_p = 0;
+ bool mouse_face_overwritten_p = false;
while (w && !FRAME_GARBAGED_P (f))
{
- if (WINDOWP (w->contents))
- mouse_face_overwritten_p
- |= expose_window_tree (XWINDOW (w->contents), r);
- else
- mouse_face_overwritten_p |= expose_window (w, r);
+ mouse_face_overwritten_p
+ |= (WINDOWP (w->contents)
+ ? expose_window_tree (XWINDOW (w->contents), r)
+ : expose_window (w, r));
w = NILP (w->next) ? NULL : XWINDOW (w->next);
}
expose_frame (struct frame *f, int x, int y, int w, int h)
{
XRectangle r;
- int mouse_face_overwritten_p = 0;
+ bool mouse_face_overwritten_p = false;
TRACE ((stderr, "expose_frame "));
/* EXPORT:
Determine the intersection of two rectangles R1 and R2. Return
- the intersection in *RESULT. Value is non-zero if RESULT is not
+ the intersection in *RESULT. Value is true if RESULT is not
empty. */
-int
+bool
x_intersect_rectangles (XRectangle *r1, XRectangle *r2, XRectangle *result)
{
XRectangle *left, *right;
XRectangle *upper, *lower;
- int intersection_p = 0;
+ bool intersection_p = false;
/* Rearrange so that R1 is the left-most rectangle. */
if (r1->x < r2->x)
result->height = (min (lower->y + lower->height,
upper->y + upper->height)
- result->y);
- intersection_p = 1;
+ intersection_p = true;
}
}
DEFSYM (Qinhibit_free_realized_faces, "inhibit-free-realized-faces");
- list_of_error = list1 (list2 (intern_c_string ("error"),
- intern_c_string ("void-variable")));
+ list_of_error = list1 (list2 (Qerror, Qvoid_variable));
staticpro (&list_of_error);
/* Values of those variables at last redisplay are stored as
DEFVAR_BOOL ("highlight-nonselected-windows", highlight_nonselected_windows,
doc: /* Non-nil means highlight region even in nonselected windows. */);
- highlight_nonselected_windows = 0;
+ highlight_nonselected_windows = false;
DEFVAR_BOOL ("multiple-frames", multiple_frames,
doc: /* Non-nil if more than one frame is visible on this display.
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. */);
- auto_raise_tool_bar_buttons_p = 1;
+ auto_raise_tool_bar_buttons_p = true;
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. */);
- make_cursor_line_fully_visible_p = 1;
+ make_cursor_line_fully_visible_p = true;
DEFVAR_LISP ("tool-bar-border", Vtool_bar_border,
doc: /* Border below tool-bar in pixels.
Note that this variable affects only how these bytes are displayed,
but does not change the fact they are interpreted as raw bytes. */);
- unibyte_display_via_language_environment = 0;
+ unibyte_display_via_language_environment = false;
DEFVAR_LISP ("max-mini-window-height", Vmax_mini_window_height,
doc: /* Maximum height for resizing mini-windows (the minibuffer and the echo area).
doc: /* Allow or disallow automatic horizontal scrolling of windows.
If non-nil, windows are automatically scrolled horizontally to make
point visible. */);
- automatic_hscrolling_p = 1;
+ automatic_hscrolling_p = true;
DEFSYM (Qauto_hscroll_mode, "auto-hscroll-mode");
DEFVAR_INT ("hscroll-margin", hscroll_margin,
DEFVAR_BOOL ("message-truncate-lines", message_truncate_lines,
doc: /* If non-nil, messages are truncated instead of resizing the echo area.
Bind this around calls to `message' to let it take effect. */);
- message_truncate_lines = 0;
+ message_truncate_lines = false;
DEFVAR_LISP ("menu-bar-update-hook", Vmenu_bar_update_hook,
doc: /* Normal hook run to update the menu bar definitions.
DEFVAR_BOOL ("inhibit-menubar-update", inhibit_menubar_update,
doc: /* Non-nil means don't update menu bars. Internal use only. */);
- inhibit_menubar_update = 0;
+ inhibit_menubar_update = false;
DEFVAR_LISP ("wrap-prefix", Vwrap_prefix,
doc: /* Prefix prepended to all continuation lines at display time.
DEFVAR_BOOL ("inhibit-eval-during-redisplay", inhibit_eval_during_redisplay,
doc: /* Non-nil means don't eval Lisp during redisplay. */);
- inhibit_eval_during_redisplay = 0;
+ inhibit_eval_during_redisplay = false;
DEFVAR_BOOL ("inhibit-free-realized-faces", inhibit_free_realized_faces,
doc: /* Non-nil means don't free realized faces. Internal use only. */);
- inhibit_free_realized_faces = 0;
+ inhibit_free_realized_faces = false;
DEFVAR_BOOL ("inhibit-bidi-mirroring", inhibit_bidi_mirroring,
doc: /* Non-nil means don't mirror characters even when bidi context requires that.
Intended for use during debugging and for testing bidi display;
see biditest.el in the test suite. */);
- inhibit_bidi_mirroring = 0;
+ inhibit_bidi_mirroring = false;
#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;
+ inhibit_try_window_id = false;
DEFVAR_BOOL ("inhibit-try-window-reusing", inhibit_try_window_reusing,
doc: /* Inhibit try_window_reusing display optimization. */);
- inhibit_try_window_reusing = 0;
+ inhibit_try_window_reusing = false;
DEFVAR_BOOL ("inhibit-try-cursor-movement", inhibit_try_cursor_movement,
doc: /* Inhibit try_cursor_movement display optimization. */);
- inhibit_try_cursor_movement = 0;
+ inhibit_try_cursor_movement = false;
#endif /* GLYPH_DEBUG */
DEFVAR_INT ("overline-margin", overline_margin,
doc: /* Non-nil means show an hourglass pointer, when Emacs is busy.
This feature only works when on a window system that can change
cursor shapes. */);
- display_hourglass_p = 1;
+ display_hourglass_p = true;
DEFVAR_LISP ("hourglass-delay", Vhourglass_delay,
doc: /* Seconds to wait before displaying an hourglass pointer when Emacs is busy. */);
#ifdef HAVE_WINDOW_SYSTEM
hourglass_atimer = NULL;
- hourglass_shown_p = 0;
+ hourglass_shown_p = false;
#endif /* HAVE_WINDOW_SYSTEM */
/* Name of the face used to display glyphless characters. */
mode_line_target = MODE_LINE_DISPLAY;
}
- help_echo_showing_p = 0;
+ help_echo_showing_p = false;
}
#ifdef HAVE_WINDOW_SYSTEM
FRAME_RIF (f)->show_hourglass (f);
}
- hourglass_shown_p = 1;
+ hourglass_shown_p = true;
unblock_input ();
}
}
#endif
}
- hourglass_shown_p = 0;
+ hourglass_shown_p = false;
unblock_input ();
}
}
realize_basic_faces (struct frame *f)
{
bool success_p = false;
- 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 ();
- specbind (Qscalable_fonts_allowed, Qt);
if (realize_default_face (f))
{
success_p = true;
}
- unbind_to (count, Qnil);
unblock_input ();
return success_p;
}
if (STRINGP (color)
&& SCHARS (color)
&& CONSP (Vtty_defined_color_alist)
- && (def = assq_no_quit (color, call1 (Qtty_color_alist, frame)),
+ && (def = assoc_no_quit (color, call1 (Qtty_color_alist, frame)),
CONSP (def)))
{
/* Associations in tty-defined-color-alist are of the form
abspath = Fexpand_file_name (filename, Qnil);
block_input ();
- fp = emacs_fopen (SSDATA (abspath), "rt");
+ fp = emacs_fopen (SSDATA (abspath), "r" FOPEN_TEXT);
if (fp)
{
char buf[512];
return dpyinfo;
}
-/* Store the screen positions of frame F into XPTR and YPTR.
+/* Return the screen positions and offsets of frame F.
+ Store the offsets between FRAME_OUTER_WINDOW and the containing
+ window manager window into LEFT_OFFSET_X, RIGHT_OFFSET_X,
+ TOP_OFFSET_Y and BOTTOM_OFFSET_Y.
+ Store the offsets between FRAME_X_WINDOW and the containing
+ window manager window into X_PIXELS_DIFF and Y_PIXELS_DIFF.
+ Store the screen positions of frame F into XPTR and YPTR.
These are the positions of the containing window manager window,
not Emacs's own window. */
-
void
-x_real_positions (struct frame *f, int *xptr, int *yptr)
+x_real_pos_and_offsets (struct frame *f,
+ int *left_offset_x,
+ int *right_offset_x,
+ int *top_offset_y,
+ int *bottom_offset_y,
+ int *x_pixels_diff,
+ int *y_pixels_diff,
+ int *xptr,
+ int *yptr,
+ int *outer_border)
{
int win_x, win_y, outer_x IF_LINT (= 0), outer_y IF_LINT (= 0);
int real_x = 0, real_y = 0;
Display *dpy = FRAME_X_DISPLAY (f);
unsigned char *tmp_data = NULL;
Atom target_type = XA_CARDINAL;
+ unsigned int ow IF_LINT (= 0), oh IF_LINT (= 0);
block_input ();
x_catch_errors (dpy);
+ if (x_pixels_diff) *x_pixels_diff = 0;
+ if (y_pixels_diff) *y_pixels_diff = 0;
+ if (left_offset_x) *left_offset_x = 0;
+ if (top_offset_y) *top_offset_y = 0;
+ if (right_offset_x) *right_offset_x = 0;
+ if (bottom_offset_y) *bottom_offset_y = 0;
+ if (xptr) *xptr = 0;
+ if (yptr) *yptr = 0;
+ if (outer_border) *outer_border = 0;
+
if (win == dpyinfo->root_window)
win = FRAME_OUTER_WINDOW (f);
/* Get the real coordinates for the WM window upper left corner */
XGetGeometry (FRAME_X_DISPLAY (f), win,
- &rootw, &real_x, &real_y, &ign, &ign, &ign, &ign);
+ &rootw, &real_x, &real_y, &ow, &oh, &ign, &ign);
+
+ if (outer_border)
+ {
+ XWindowAttributes atts;
+ XGetWindowAttributes (FRAME_X_DISPLAY (f), win, &atts);
+ *outer_border = atts.border_width;
+ }
/* Translate real coordinates to coordinates relative to our
window. For our window, the upper left corner is 0, 0.
if (had_errors) return;
- f->x_pixels_diff = -win_x;
- f->y_pixels_diff = -win_y;
+ if (x_pixels_diff) *x_pixels_diff = -win_x;
+ if (y_pixels_diff) *y_pixels_diff = -win_y;
+
+ if (left_offset_x) *left_offset_x = -outer_x;
+ if (top_offset_y) *top_offset_y = -outer_y;
- FRAME_X_OUTPUT (f)->x_pixels_outer_diff = -outer_x;
- FRAME_X_OUTPUT (f)->y_pixels_outer_diff = -outer_y;
+ if (xptr) *xptr = real_x;
+ if (yptr) *yptr = real_y;
- *xptr = real_x;
- *yptr = real_y;
+ if (right_offset_x || bottom_offset_y)
+ {
+ int xy_ign;
+ unsigned int ign, fw, fh;
+ Window rootw;
+
+ XGetGeometry (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
+ &rootw, &xy_ign, &xy_ign, &fw, &fh, &ign, &ign);
+ if (right_offset_x) *right_offset_x = ow - fw + outer_x;
+ if (bottom_offset_y) *bottom_offset_y = oh - fh + outer_y;
+ }
+}
+
+/* Store the screen positions of frame F into XPTR and YPTR.
+ These are the positions of the containing window manager window,
+ not Emacs's own window. */
+
+void
+x_real_positions (struct frame *f, int *xptr, int *yptr)
+{
+ x_real_pos_and_offsets (f, NULL, NULL, NULL, NULL, NULL, NULL, xptr, yptr,
+ NULL);
}
+
/* Get the mouse position in frame relative coordinates. */
void
we don't care. */
(unsigned int *) &dummy);
- unblock_input ();
+ XTranslateCoordinates (FRAME_X_DISPLAY (f),
+
+ /* From-window, to-window. */
+ FRAME_DISPLAY_INFO (f)->root_window,
+ FRAME_X_WINDOW (f),
+
+ /* From-position, to-position. */
+ *x, *y, x, y,
+
+ /* Child of win. */
+ &dummy_window);
- /* Translate root window coordinates to window coordinates. */
- *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
- *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
+ unblock_input ();
}
/* Gamma-correct COLOR on frame F. */
int unit = FRAME_LINE_HEIGHT (f);
int old_height = FRAME_TOOL_BAR_HEIGHT (f);
int lines = (height + unit - 1) / unit;
+ Lisp_Object fullscreen;
/* Make sure we redisplay all windows in this frame. */
windows_or_buffers_changed = 60;
f->n_tool_bar_rows = 0;
adjust_frame_size (f, -1, -1,
- (!f->tool_bar_redisplayed_once ? 1
+ ((!f->tool_bar_redisplayed_once
+ && (NILP (fullscreen =
+ get_frame_param (f, Qfullscreen))
+ || EQ (fullscreen, Qfullwidth))) ? 1
: (old_height == 0 || height == 0) ? 2
: 4),
false, Qtool_bar_lines);
"title", "Title", RES_TYPE_STRING);
x_default_parameter (f, parms, Qwait_for_wm, Qt,
"waitForWM", "WaitForWM", RES_TYPE_BOOLEAN);
- x_default_parameter (f, parms, Qfullscreen, Qnil,
- "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
x_default_parameter (f, parms, Qtool_bar_position,
FRAME_TOOL_BAR_POSITION (f), 0, 0, RES_TYPE_SYMBOL);
x_wm_set_size_hint (f, window_prompting, false);
unblock_input ();
+ /* Process fullscreen parameter here in the hope that normalizing a
+ fullheight/fullwidth frame will produce the size set by the last
+ adjust_frame_size call. */
+ x_default_parameter (f, parms, Qfullscreen, Qnil,
+ "fullscreen", "Fullscreen", RES_TYPE_SYMBOL);
+
/* Make the window appear on the frame and enable display, unless
the caller says not to. However, with explicit parent, Emacs
cannot control visibility, so don't try. */
Lisp_Object fullscreen = Fframe_parameter (frame, Qfullscreen);
int menu_bar_height, menu_bar_width, tool_bar_height, tool_bar_width;
- border = FRAME_OUTER_TO_INNER_DIFF_X (f);
- title = FRAME_X_OUTPUT (f)->y_pixels_outer_diff - border;
+ int left_off, right_off, top_off, bottom_off, outer_border;
+ XWindowAttributes atts;
+
+ block_input ();
+
+ XGetWindowAttributes (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &atts);
+
+ x_real_pos_and_offsets (f, &left_off, &right_off, &top_off, &bottom_off,
+ NULL, NULL, NULL, NULL, &outer_border);
+
+
+ unblock_input ();
+
+ border = atts.border_width;
+ title = top_off;
- outer_width = FRAME_PIXEL_WIDTH (f) + 2 * border;
- outer_height = (FRAME_PIXEL_HEIGHT (f)
- + FRAME_OUTER_TO_INNER_DIFF_Y (f)
- + FRAME_OUTER_TO_INNER_DIFF_X (f));
+ outer_width = atts.width + 2 * border + right_off + left_off
+ + 2 * outer_border;
+ outer_height = atts.height + 2 * border + top_off + bottom_off
+ + 2 * outer_border;
#if defined (USE_GTK)
{
tool_bar_height = (tool_bar_left_right
? FRAME_PIXEL_HEIGHT (f)
: FRAME_TOOLBAR_HEIGHT (f));
- if (tool_bar_left_right)
- /* For some reason FRAME_OUTER_TO_INNER_DIFF_X does not count the
- width of a tool bar. */
- outer_width += FRAME_TOOLBAR_WIDTH (f);
}
#else
tool_bar_height = FRAME_TOOL_BAR_HEIGHT (f);
- tool_bar_width = ((tool_bar_height > 0)
- ? outer_width - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)
- : 0);
+ tool_bar_width = tool_bar_height > 0 ? FRAME_PIXEL_WIDTH (f) : 0;
#endif
#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
menu_bar_height = FRAME_MENU_BAR_HEIGHT (f);
#endif
- menu_bar_width = ((menu_bar_height > 0)
- ? outer_width - 2 * border
- : 0);
+ menu_bar_width = menu_bar_height > 0 ? FRAME_PIXEL_WIDTH (f) : 0;
if (!FRAME_EXTERNAL_MENU_BAR (f))
inner_height -= menu_bar_height;
inner_height -= tool_bar_height;
return
- listn (CONSTYPE_PURE, 10,
+ listn (CONSTYPE_HEAP, 10,
Fcons (Qframe_position,
Fcons (make_number (f->left_pos), make_number (f->top_pos))),
Fcons (Qframe_outer_size,
Lisp_Object disptype;
if (FRAME_DISPLAY_INFO (f)->n_planes == 1)
- disptype = intern ("mono");
+ disptype = Qmono;
else if (FRAME_DISPLAY_INFO (f)->visual->class == GrayScale
|| FRAME_DISPLAY_INFO (f)->visual->class == StaticGray)
disptype = intern ("grayscale");
GCPRO2 (font_param, font);
XSETFONT (font, FRAME_FONT (f));
- font_param = Ffont_get (font, intern (":name"));
+ font_param = Ffont_get (font, QCname);
if (STRINGP (font_param))
default_name = xlispstrdup (font_param);
else
DEFSYM (Qcompound_text, "compound-text");
DEFSYM (Qcancel_timer, "cancel-timer");
DEFSYM (Qfont_param, "font-parameter");
+ DEFSYM (Qmono, "mono");
Fput (Qundefined_color, Qerror_conditions,
listn (CONSTYPE_PURE, 2, Qundefined_color, Qerror));
indices[i] = names[i];
qsort (indices, num_fonts, sizeof (char *), compare_font_names);
- for (i = 0; i < num_fonts; i++)
- {
- ptrdiff_t len;
+ /* Take one or two passes over the font list. Do the second
+ pass only if we really need it, i.e., only if the first pass
+ found no fonts and skipped some scalable fonts. */
+ bool skipped_some_scalable_fonts = false;
+ for (int i_pass = 0;
+ (i_pass == 0
+ || (i_pass == 1 && NILP (list) && skipped_some_scalable_fonts));
+ i_pass++)
+ for (i = 0; i < num_fonts; i++)
+ {
+ ptrdiff_t len;
+
+ if (i > 0 && xstrcasecmp (indices[i - 1], indices[i]) == 0)
+ continue;
+ if (NILP (entity))
+ entity = font_make_entity ();
+ 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. */
+ if (INTEGERP (AREF (entity, FONT_DPI_INDEX))
+ && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
+ && XINT (AREF (entity, FONT_DPI_INDEX)) != 0
+ && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0)
+ continue;
+ /* Avoid not-allowed scalable fonts. */
+ if (NILP (Vscalable_fonts_allowed))
+ {
+ int size = 0;
- if (i > 0 && xstrcasecmp (indices[i - 1], indices[i]) == 0)
- continue;
- if (NILP (entity))
- entity = font_make_entity ();
- 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. */
- if (INTEGERP (AREF (entity, FONT_DPI_INDEX))
- && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
- && XINT (AREF (entity, FONT_DPI_INDEX)) != 0
- && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0)
- continue;
- /* Avoid not-allowed scalable fonts. */
- if (NILP (Vscalable_fonts_allowed))
- {
- int size = 0;
+ if (INTEGERP (AREF (entity, FONT_SIZE_INDEX)))
+ size = XINT (AREF (entity, FONT_SIZE_INDEX));
+ else if (FLOATP (AREF (entity, FONT_SIZE_INDEX)))
+ size = XFLOAT_DATA (AREF (entity, FONT_SIZE_INDEX));
+ if (size == 0 && i_pass == 0)
+ {
+ skipped_some_scalable_fonts = true;
+ continue;
+ }
+ }
+ else if (CONSP (Vscalable_fonts_allowed))
+ {
+ Lisp_Object tail;
- if (INTEGERP (AREF (entity, FONT_SIZE_INDEX)))
- size = XINT (AREF (entity, FONT_SIZE_INDEX));
- else if (FLOATP (AREF (entity, FONT_SIZE_INDEX)))
- size = XFLOAT_DATA (AREF (entity, FONT_SIZE_INDEX));
- if (size == 0)
- continue;
- }
- else if (CONSP (Vscalable_fonts_allowed))
- {
- Lisp_Object tail, elt;
-
- for (tail = Vscalable_fonts_allowed; CONSP (tail);
- tail = XCDR (tail))
- {
- elt = XCAR (tail);
- if (STRINGP (elt)
- && fast_c_string_match_ignore_case (elt, indices[i],
- len) >= 0)
- break;
- }
- if (! CONSP (tail))
- continue;
- }
+ for (tail = Vscalable_fonts_allowed; CONSP (tail);
+ tail = XCDR (tail))
+ {
+ Lisp_Object elt = XCAR (tail);
+ if (STRINGP (elt)
+ && (fast_c_string_match_ignore_case (elt, indices[i],
+ len)
+ >= 0))
+ break;
+ }
+ if (! CONSP (tail))
+ continue;
+ }
- /* Avoid fonts of invalid registry. */
- if (NILP (AREF (entity, FONT_REGISTRY_INDEX)))
- continue;
+ /* Avoid fonts of invalid registry. */
+ if (NILP (AREF (entity, FONT_REGISTRY_INDEX)))
+ continue;
- /* Update encoding and repertory if necessary. */
- if (! EQ (registry, AREF (entity, FONT_REGISTRY_INDEX)))
- {
- registry = AREF (entity, FONT_REGISTRY_INDEX);
- if (font_registry_charsets (registry, &encoding, &repertory) < 0)
- encoding = NULL;
- }
- if (! encoding)
- /* Unknown REGISTRY, not supported. */
- continue;
- if (repertory)
- {
- if (NILP (script)
- || xfont_chars_supported (chars, NULL, encoding, repertory))
- list = Fcons (entity, list), entity = Qnil;
+ /* Update encoding and repertory if necessary. */
+ if (! EQ (registry, AREF (entity, FONT_REGISTRY_INDEX)))
+ {
+ registry = AREF (entity, FONT_REGISTRY_INDEX);
+ if (font_registry_charsets (registry, &encoding, &repertory) < 0)
+ encoding = NULL;
+ }
+ if (! encoding)
+ /* Unknown REGISTRY, not supported. */
continue;
- }
- if (memcmp (props, aref_addr (entity, FONT_FOUNDRY_INDEX),
- word_size * 7)
- || ! EQ (AREF (entity, FONT_SPACING_INDEX), props[7]))
- {
- 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);
- }
- if (NILP (script)
- || ! NILP (Fmemq (script, scripts)))
- list = Fcons (entity, list), entity = Qnil;
- }
+ if (repertory)
+ {
+ if (NILP (script)
+ || xfont_chars_supported (chars, NULL, encoding, repertory))
+ list = Fcons (entity, list), entity = Qnil;
+ continue;
+ }
+ if (memcmp (props, aref_addr (entity, FONT_FOUNDRY_INDEX),
+ word_size * 7)
+ || ! EQ (AREF (entity, FONT_SPACING_INDEX), props[7]))
+ {
+ 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);
+ }
+ if (NILP (script)
+ || ! NILP (Fmemq (script, scripts)))
+ list = Fcons (entity, list), entity = Qnil;
+ }
XFreeFontNames (names);
}
if (use_pos_func)
{
+ Window dummy_window;
+
/* Not invoked by a click. pop up at x/y. */
pos_func = menu_position_func;
/* Adjust coordinates to be root-window-relative. */
- x += f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
- y += f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
+ block_input ();
+ XTranslateCoordinates (FRAME_X_DISPLAY (f),
+
+ /* From-window, to-window. */
+ FRAME_X_WINDOW (f),
+ FRAME_DISPLAY_INFO (f)->root_window,
+ /* From-position, to-position. */
+ x, y, &x, &y,
+
+ /* Child of win. */
+ &dummy_window);
+ unblock_input ();
popup_x_y.x = x;
popup_x_y.y = y;
popup_x_y.f = f;
XButtonPressedEvent *event = &(dummy.xbutton);
LWLIB_ID menu_id;
Widget menu;
+ Window dummy_window;
eassert (FRAME_X_P (f));
event->y = y;
/* Adjust coordinates to be root-window-relative. */
- x += f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
- y += f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
+ block_input ();
+ x += FRAME_LEFT_SCROLL_BAR_AREA_WIDTH (f);
+ XTranslateCoordinates (FRAME_X_DISPLAY (f),
+
+ /* From-window, to-window. */
+ FRAME_X_WINDOW (f),
+ FRAME_DISPLAY_INFO (f)->root_window,
+
+ /* From-position, to-position. */
+ x, y, &x, &y,
+
+ /* Child of win. */
+ &dummy_window);
+ unblock_input ();
event->x_root = x;
event->y_root = y;
inhibit_garbage_collection ();
#ifdef HAVE_X_WINDOWS
- /* Adjust coordinates to relative to the outer (window manager) window. */
- x += FRAME_OUTER_TO_INNER_DIFF_X (f);
- y += FRAME_OUTER_TO_INNER_DIFF_Y (f);
+ {
+ /* Adjust coordinates to relative to the outer (window manager) window. */
+ int left_off, top_off;
+
+ x_real_pos_and_offsets (f, &left_off, NULL, &top_off, NULL,
+ NULL, NULL, NULL, NULL, NULL);
+
+ x += left_off;
+ y += top_off;
+ }
#endif /* HAVE_X_WINDOWS */
- /* Adjust coordinates to be root-window-relative. */
x += f->left_pos;
y += f->top_pos;
if (node != NULL)
result = make_dom (node);
} else
- result = Fcons (intern ("top"),
- Fcons (Qnil, Fnreverse (Fcons (r, result))));
+ result = Fcons (Qtop, Fcons (Qnil, Fnreverse (Fcons (r, result))));
xmlFreeDoc (doc);
}
static struct prop_location *property_change_wait_list;
+static void
+set_property_change_object (struct prop_location *location)
+{
+ /* Input must be blocked so we don't get the event before we set these. */
+ if (! input_blocked_p ())
+ emacs_abort ();
+ XSETCAR (property_change_reply, Qnil);
+ property_change_reply_object = location;
+}
+
\f
/* Send the reply to a selection request event EVENT. */
{
int format_bytes = cs->format / 8;
bool had_errors_p = x_had_errors_p (display);
+
+ /* Must set this inside block_input (). unblock_input may read
+ events and setting property_change_reply in
+ wait_for_property_change is then too late. */
+ set_property_change_object (cs->wait_object);
unblock_input ();
bytes_remaining = cs->size;
: format_bytes);
XFlush (display);
had_errors_p = x_had_errors_p (display);
+ // See comment above about property_change_reply.
+ set_property_change_object (cs->wait_object);
unblock_input ();
if (had_errors_p) break;
{
ptrdiff_t count = SPECPDL_INDEX ();
- if (property_change_reply_object)
- emacs_abort ();
-
/* Make sure to do unexpect_property_change if we quit or err. */
record_unwind_protect_ptr (wait_for_property_change_unwind, location);
- XSETCAR (property_change_reply, Qnil);
- property_change_reply_object = location;
+ /* See comment in x_reply_selection_request about setting
+ property_change_reply. Do not do it here. */
/* If the event we are waiting for arrives beyond here, it will set
property_change_reply, because property_change_reply_object says so. */
wait_object = expect_property_change (display, window, property,
PropertyNewValue);
XFlush (display);
+ // See comment in x_reply_selection_request about property_change_reply.
+ set_property_change_object (wait_object);
unblock_input ();
while (true)
XDeleteProperty (display, window, property);
wait_object = expect_property_change (display, window, property,
PropertyNewValue);
+ // See comment in x_reply_selection_request about property_change_reply.
+ set_property_change_object (wait_object);
XFlush (display);
unblock_input ();
int val_idx = 0, vp_idx = 0;
int props_idx = 0;
int i;
- char *cwd = get_current_dir_name ();
char *smid_opt, *chdir_opt = NULL;
+ Lisp_Object user_login_name = Fuser_login_name (Qnil);
+
+ // Must have these.
+ if (! STRINGP (Vinvocation_name) || ! STRINGP (user_login_name))
+ return;
/* How to start a new instance of Emacs. */
props[props_idx] = &prop_ptr[props_idx];
props[props_idx]->type = xstrdup (SmARRAY8);
props[props_idx]->num_vals = 1;
props[props_idx]->vals = &values[val_idx++];
- props[props_idx]->vals[0].length = SBYTES (Vuser_login_name);
- props[props_idx]->vals[0].value = SDATA (Vuser_login_name);
+ props[props_idx]->vals[0].length = SBYTES (user_login_name);
+ props[props_idx]->vals[0].value = SDATA (user_login_name);
++props_idx;
-
+ char *cwd = get_current_dir_name ();
if (cwd)
{
props[props_idx] = &prop_ptr[props_idx];
-1, -1, 1, 1,
CopyFromParent, CopyFromParent, CopyFromParent);
+ validate_x_resource_name ();
class_hints.res_name = SSDATA (Vx_resource_name);
class_hints.res_class = SSDATA (Vx_resource_class);
XSetClassHint (dpyinfo->display, w, &class_hints);
/* Check if we where started by the session manager. If so, we will
have a previous id. */
- if (! NILP (Vx_session_previous_id) && STRINGP (Vx_session_previous_id))
+ if (STRINGP (Vx_session_previous_id))
previous_id = SSDATA (Vx_session_previous_id);
/* Construct the path to the Emacs program. */
- if (! NILP (Vinvocation_directory))
+ if (STRINGP (Vinvocation_directory))
name_len += SBYTES (Vinvocation_directory);
- name_len += SBYTES (Vinvocation_name);
+ if (STRINGP (Vinvocation_name))
+ name_len += SBYTES (Vinvocation_name);
/* This malloc will not be freed, but it is only done once, and hopefully
not very large */
emacs_program = xmalloc (name_len + 1);
char *z = emacs_program;
- if (! NILP (Vinvocation_directory))
+ if (STRINGP (Vinvocation_directory))
z = lispstpcpy (z, Vinvocation_directory);
- lispstpcpy (z, Vinvocation_name);
+ if (STRINGP (Vinvocation_name))
+ lispstpcpy (z, Vinvocation_name);
/* The SM protocol says all callbacks are mandatory, so set up all
here and in the mask passed to SmcOpenConnection. */
#include "coding.h"
#include "frame.h"
#include "dispextern.h"
-#ifdef HAVE_XWIDGETS
-#include "xwidget.h"
-#endif
#include "fontset.h"
#include "termhooks.h"
#include "termopts.h"
};
static bool x_alloc_nearest_color_1 (Display *, Colormap, XColor *);
-static void x_set_window_size_1 (struct frame *, bool, int, int, bool);
+static void x_set_window_size_1 (struct frame *, bool, int, int);
static void x_raise_frame (struct frame *);
static void x_lower_frame (struct frame *);
static const XColor *x_color_cells (Display *, int *);
x_draw_image_glyph_string (s);
break;
-#ifdef HAVE_XWIDGETS
- case XWIDGET_GLYPH:
- //erase xwidget background
- //x_draw_glyph_string_background (s, 0);
- x_draw_xwidget_glyph_string (s);
- break;
-#endif
case STRETCH_GLYPH:
x_draw_stretch_glyph_string (s);
break;
break;
}
+ frame_size_history_add
+ (f, Qx_net_wm_state, 0, 0,
+ list2 (get_frame_param (f, Qfullscreen), lval));
+
store_frame_param (f, Qfullscreen, lval);
/** store_frame_param (f, Qsticky, sticky ? Qt : Qnil); **/
}
goto OTHER;
case MapNotify:
- if (event->xmap.window == tip_window)
- /* The tooltip has been drawn already. Avoid
- the SET_FRAME_GARBAGED below. */
- goto OTHER;
-
/* We use x_top_window_to_frame because map events can
come for sub-windows and they don't mean that the
frame is visible. */
{
x_net_wm_state (f, event->xconfigure.window);
+#ifdef USE_X_TOOLKIT
+ /* Tip frames are pure X window, set size for them. */
+ if (! NILP (tip_frame) && XFRAME (tip_frame) == f)
+ {
+ if (FRAME_PIXEL_HEIGHT (f) != event->xconfigure.height
+ || FRAME_PIXEL_WIDTH (f) != event->xconfigure.width)
+ SET_FRAME_GARBAGED (f);
+ FRAME_PIXEL_HEIGHT (f) = event->xconfigure.height;
+ FRAME_PIXEL_WIDTH (f) = event->xconfigure.width;
+ }
+#endif
+
#ifndef USE_X_TOOLKIT
#ifndef USE_GTK
int width = FRAME_PIXEL_TO_TEXT_WIDTH (f, event->xconfigure.width);
if (cursor_glyph == NULL)
return;
-#ifdef HAVE_XWIDGETS
- if (cursor_glyph->type == XWIDGET_GLYPH){
- return; //experimental avoidance of cursor on xwidget
- }
-#endif
/* If on an image, draw like a normal cursor. That's usually better
visible than drawing a bar, esp. if the image is large so that
the bar might not be in the window. */
None);
break;
case FULLSCREEN_WIDTH:
- if (cur == FULLSCREEN_BOTH || cur == FULLSCREEN_HEIGHT
- || cur == FULLSCREEN_MAXIMIZED)
- set_wm_state (frame, false, dpyinfo->Xatom_net_wm_state_fullscreen,
- dpyinfo->Xatom_net_wm_state_maximized_vert);
- if (cur != FULLSCREEN_MAXIMIZED)
- set_wm_state (frame, true,
- dpyinfo->Xatom_net_wm_state_maximized_horz, None);
+ if (x_frame_normalize_before_maximize && cur == FULLSCREEN_MAXIMIZED)
+ {
+ set_wm_state (frame, false,
+ dpyinfo->Xatom_net_wm_state_maximized_horz,
+ dpyinfo->Xatom_net_wm_state_maximized_vert);
+ set_wm_state (frame, true,
+ dpyinfo->Xatom_net_wm_state_maximized_horz, None);
+ }
+ else
+ {
+ if (cur == FULLSCREEN_BOTH || cur == FULLSCREEN_HEIGHT
+ || cur == FULLSCREEN_MAXIMIZED)
+ set_wm_state (frame, false, dpyinfo->Xatom_net_wm_state_fullscreen,
+ dpyinfo->Xatom_net_wm_state_maximized_vert);
+ if (cur != FULLSCREEN_MAXIMIZED || x_frame_normalize_before_maximize)
+ set_wm_state (frame, true,
+ dpyinfo->Xatom_net_wm_state_maximized_horz, None);
+ }
break;
case FULLSCREEN_HEIGHT:
- if (cur == FULLSCREEN_BOTH || cur == FULLSCREEN_WIDTH
- || cur == FULLSCREEN_MAXIMIZED)
- set_wm_state (frame, false, dpyinfo->Xatom_net_wm_state_fullscreen,
- dpyinfo->Xatom_net_wm_state_maximized_horz);
- if (cur != FULLSCREEN_MAXIMIZED)
- set_wm_state (frame, true,
- dpyinfo->Xatom_net_wm_state_maximized_vert, None);
+ if (x_frame_normalize_before_maximize && cur == FULLSCREEN_MAXIMIZED)
+ {
+ set_wm_state (frame, false,
+ dpyinfo->Xatom_net_wm_state_maximized_horz,
+ dpyinfo->Xatom_net_wm_state_maximized_vert);
+ set_wm_state (frame, true,
+ dpyinfo->Xatom_net_wm_state_maximized_vert, None);
+ }
+ else
+ {
+ if (cur == FULLSCREEN_BOTH || cur == FULLSCREEN_WIDTH
+ || cur == FULLSCREEN_MAXIMIZED)
+ set_wm_state (frame, false, dpyinfo->Xatom_net_wm_state_fullscreen,
+ dpyinfo->Xatom_net_wm_state_maximized_horz);
+ if (cur != FULLSCREEN_MAXIMIZED || x_frame_normalize_before_maximize)
+ set_wm_state (frame, true,
+ dpyinfo->Xatom_net_wm_state_maximized_vert, None);
+ }
break;
case FULLSCREEN_MAXIMIZED:
- if (cur == FULLSCREEN_BOTH)
- set_wm_state (frame, false, dpyinfo->Xatom_net_wm_state_fullscreen,
- None);
- set_wm_state (frame, true,
- dpyinfo->Xatom_net_wm_state_maximized_horz,
- dpyinfo->Xatom_net_wm_state_maximized_vert);
+ if (x_frame_normalize_before_maximize && cur == FULLSCREEN_BOTH)
+ {
+ set_wm_state (frame, false,
+ dpyinfo->Xatom_net_wm_state_fullscreen, None);
+ set_wm_state (frame, true,
+ dpyinfo->Xatom_net_wm_state_maximized_horz,
+ dpyinfo->Xatom_net_wm_state_maximized_vert);
+ }
+ else if (x_frame_normalize_before_maximize && cur == FULLSCREEN_WIDTH)
+ {
+ set_wm_state (frame, false,
+ dpyinfo->Xatom_net_wm_state_maximized_horz, None);
+ set_wm_state (frame, true,
+ dpyinfo->Xatom_net_wm_state_maximized_horz,
+ dpyinfo->Xatom_net_wm_state_maximized_vert);
+ }
+ else if (x_frame_normalize_before_maximize && cur == FULLSCREEN_HEIGHT)
+ {
+ set_wm_state (frame, false,
+ dpyinfo->Xatom_net_wm_state_maximized_vert, None);
+ set_wm_state (frame, true,
+ dpyinfo->Xatom_net_wm_state_maximized_horz,
+ dpyinfo->Xatom_net_wm_state_maximized_vert);
+ }
+ else
+ {
+ if (cur == FULLSCREEN_BOTH)
+ set_wm_state (frame, false, dpyinfo->Xatom_net_wm_state_fullscreen,
+ None);
+ else if (cur == FULLSCREEN_HEIGHT)
+ set_wm_state (frame, true,
+ dpyinfo->Xatom_net_wm_state_maximized_horz, None);
+ else if (cur == FULLSCREEN_WIDTH)
+ set_wm_state (frame, true, None,
+ dpyinfo->Xatom_net_wm_state_maximized_vert);
+ else
+ set_wm_state (frame, true,
+ dpyinfo->Xatom_net_wm_state_maximized_horz,
+ dpyinfo->Xatom_net_wm_state_maximized_vert);
+ }
break;
case FULLSCREEN_NONE:
if (cur == FULLSCREEN_BOTH)
break;
}
+ frame_size_history_add
+ (f, Qx_handle_net_wm_state, 0, 0,
+ list2 (get_frame_param (f, Qfullscreen), lval));
+
store_frame_param (f, Qfullscreen, lval);
store_frame_param (f, Qsticky, sticky ? Qt : Qnil);
break;
case FULLSCREEN_WIDTH:
width = x_display_pixel_width (dpyinfo);
- break;
+ height = height + FRAME_MENUBAR_HEIGHT (f);
+ break;
case FULLSCREEN_HEIGHT:
height = x_display_pixel_height (dpyinfo);
}
+ frame_size_history_add
+ (f, Qx_check_fullscreen, width, height, Qnil);
+
XResizeWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
- width, height);
+ width, height);
+
+ if (FRAME_VISIBLE_P (f))
+ x_wait_for_event (f, ConfigureNotify);
+ else
+ {
+ change_frame_size (f, width, height - FRAME_MENUBAR_HEIGHT (f),
+ false, true, false, true);
+ x_sync (f);
+ }
}
}
static void
x_set_window_size_1 (struct frame *f, bool change_gravity,
- int width, int height, bool pixelwise)
+ int width, int height)
{
- int pixelwidth, pixelheight;
-
- pixelwidth = (pixelwise
- ? FRAME_TEXT_TO_PIXEL_WIDTH (f, width)
- : FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, width));
- pixelheight = ((pixelwise
- ? FRAME_TEXT_TO_PIXEL_HEIGHT (f, height)
- : FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, height)));
+ int pixelwidth = FRAME_TEXT_TO_PIXEL_WIDTH (f, width);
+ int pixelheight = FRAME_TEXT_TO_PIXEL_HEIGHT (f, height);
+ int old_width = FRAME_PIXEL_WIDTH (f);
+ int old_height = FRAME_PIXEL_HEIGHT (f);
+ Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
if (change_gravity) f->win_gravity = NorthWestGravity;
x_wm_set_size_hint (f, 0, false);
- XResizeWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
- pixelwidth, pixelheight + FRAME_MENUBAR_HEIGHT (f));
+
+ /* When the frame is fullheight and we only want to change the width
+ or it is fullwidth and we only want to change the height we should
+ be able to preserve the fullscreen property. However, due to the
+ fact that we have to send a resize request anyway, the window
+ manager will abolish it. At least the respective size should
+ remain unchanged but giving the frame back its normal size will
+ be broken ... */
+ if (EQ (fullscreen, Qfullwidth) && width == FRAME_TEXT_WIDTH (f))
+ {
+ frame_size_history_add
+ (f, Qxg_frame_set_char_size_1, width, height,
+ list2 (make_number (old_height),
+ make_number (pixelheight + FRAME_MENUBAR_HEIGHT (f))));
+
+ XResizeWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
+ old_width, pixelheight + FRAME_MENUBAR_HEIGHT (f));
+ }
+ else if (EQ (fullscreen, Qfullheight) && height == FRAME_TEXT_HEIGHT (f))
+ {
+ frame_size_history_add
+ (f, Qxg_frame_set_char_size_2, width, height,
+ list2 (make_number (old_width), make_number (pixelwidth)));
+
+ XResizeWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
+ pixelwidth, old_height);
+ }
+
+ else
+ {
+ frame_size_history_add
+ (f, Qxg_frame_set_char_size_3, width, height,
+ list2 (make_number (pixelwidth + FRAME_TOOLBAR_WIDTH (f)),
+ make_number (pixelheight + FRAME_TOOLBAR_HEIGHT (f)
+ + FRAME_MENUBAR_HEIGHT (f))));
+
+ XResizeWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
+ pixelwidth, pixelheight + FRAME_MENUBAR_HEIGHT (f));
+ fullscreen = Qnil;
+ }
+
/* We've set {FRAME,PIXEL}_{WIDTH,HEIGHT} to the values we hope to
not right if the frame is visible. Instead wait (with timeout)
for the ConfigureNotify. */
if (FRAME_VISIBLE_P (f))
- x_wait_for_event (f, ConfigureNotify);
+ {
+ x_wait_for_event (f, ConfigureNotify);
+
+ if (!NILP (fullscreen))
+ /* Try to restore fullscreen state. */
+ {
+ store_frame_param (f, Qfullscreen, fullscreen);
+ x_set_fullscreen (f, fullscreen, fullscreen);
+ }
+ }
else
{
change_frame_size (f, width, height, false, true, false, true);
}
#endif
+ /* Pixelize width and height, if necessary. */
+ if (! pixelwise)
+ {
+ width = width * FRAME_COLUMN_WIDTH (f);
+ height = height * FRAME_LINE_HEIGHT (f);
+ }
+
#ifdef USE_GTK
if (FRAME_GTK_WIDGET (f))
- if (! pixelwise)
- xg_frame_set_char_size (f, width * FRAME_COLUMN_WIDTH (f),
- height * FRAME_LINE_HEIGHT (f));
- else
- xg_frame_set_char_size (f, width, height);
+ xg_frame_set_char_size (f, width, height);
else
- x_set_window_size_1 (f, change_gravity, width, height, pixelwise);
+ x_set_window_size_1 (f, change_gravity, width, height);
#else /* not USE_GTK */
-
- x_set_window_size_1 (f, change_gravity, width, height, pixelwise);
+ x_set_window_size_1 (f, change_gravity, width, height);
x_clear_under_internal_border (f);
-
#endif /* not USE_GTK */
/* If cursor was outside the new size, mark it as off. */
bool
x_display_ok (const char *display)
{
+ /* XOpenDisplay fails if it gets a signal. Block SIGIO which may arrive. */
+ unrequest_sigio ();
Display *dpy = XOpenDisplay (display);
+ request_sigio ();
if (!dpy)
return false;
XCloseDisplay (dpy);
/* gtk_init does set_locale. Fix locale before and after. */
fixup_locale ();
+ unrequest_sigio (); /* See comment in x_display_ok. */
gtk_init (&argc, &argv2);
+ request_sigio ();
fixup_locale ();
g_log_remove_handler ("GLib", id);
argv[argc++] = xrm_option;
}
turn_on_atimers (false);
+ unrequest_sigio (); /* See comment in x_display_ok. */
dpy = XtOpenDisplay (Xt_app_con, SSDATA (display_name),
resource_name, EMACS_CLASS,
emacs_options, XtNumber (emacs_options),
&argc, argv);
+ request_sigio ();
turn_on_atimers (true);
#ifdef HAVE_X11XTR6
#else /* not USE_X_TOOLKIT */
XSetLocaleModifiers ("");
+ unrequest_sigio (); // See comment in x_display_ok.
dpy = XOpenDisplay (SSDATA (display_name));
+ request_sigio ();
#endif /* not USE_X_TOOLKIT */
#endif /* not USE_GTK*/
make_float (DEFAULT_REHASH_SIZE),
make_float (DEFAULT_REHASH_THRESHOLD),
Qnil);
+
+ DEFVAR_BOOL ("x-frame-normalize-before-maximize",
+ x_frame_normalize_before_maximize,
+ doc: /* Non-nil means normalize frame before maximizing.
+If this variable is t, Emacs first asks the window manager to give the
+frame its normal size, and only then the final state, whenever changing
+from a full-height, full-width or full-both state to the maximized one
+or when changing from the maximized to the full-height or full-width
+state.
+
+Set this variable only if your window manager cannot handle the
+transition between the various maximization states. */);
+ x_frame_normalize_before_maximize = false;
}
They are changed only when a different background is involved. */
unsigned long relief_background;
- /* As x_pixels_diff, but to FRAME_OUTER_WINDOW. For some reason the
- two might differ by a pixel, depending on WM */
- int x_pixels_outer_diff;
-
- /* As y_pixels_diff, but to FRAME_OUTER_WINDOW. In the toolkit version,
- these may differ because this does not take into account possible
- menubar. y_pixels_diff is with menubar height included */
- int y_pixels_outer_diff;
-
/* Keep track of focus. May be EXPLICIT if we received a FocusIn for this
frame, or IMPLICIT if we received an EnterNotify.
FocusOut and LeaveNotify clears EXPLICIT/IMPLICIT. */
/* This is the Colormap which frame F uses. */
#define FRAME_X_COLORMAP(f) FRAME_DISPLAY_INFO (f)->cmap
-/* The difference in pixels between the top left corner of the
- Emacs window (including possible window manager decorations)
- and FRAME_X_WINDOW (f). */
-#define FRAME_OUTER_TO_INNER_DIFF_X(f) \
- ((f)->output_data.x->x_pixels_outer_diff)
-#define FRAME_OUTER_TO_INNER_DIFF_Y(f) \
- ((f)->output_data.x->y_pixels_outer_diff \
- + FRAME_MENUBAR_HEIGHT (f) + FRAME_TOOLBAR_HEIGHT (f))
-
-
#define FRAME_XIC(f) ((f)->output_data.x->xic)
#define FRAME_X_XIM(f) (FRAME_DISPLAY_INFO (f)->xim)
#define FRAME_X_XIM_STYLES(f) (FRAME_DISPLAY_INFO (f)->xim_styles)
extern void x_free_gcs (struct frame *);
extern void x_relative_mouse_position (struct frame *, int *, int *);
+extern void x_real_pos_and_offsets (struct frame *f,
+ int *left_offset_x,
+ int *right_offset_x,
+ int *top_offset_y,
+ int *bottom_offset_y,
+ int *x_pixels_diff,
+ int *y_pixels_diff,
+ int *xptr,
+ int *yptr,
+ int *outer_border);
/* From xrdb.c. */
+++ /dev/null
-#include <config.h>
-#ifdef HAVE_XWIDGETS
-
-#include <signal.h>
-
-#include <stdio.h>
-#include <setjmp.h>
-#ifdef HAVE_X_WINDOWS
-
-#include "lisp.h"
-#include "blockinput.h"
-#include "syssignal.h"
-
-#include "xterm.h"
-#include <X11/cursorfont.h>
-
-#ifndef makedev
-#include <sys/types.h>
-#endif /* makedev */
-
-#ifdef BSD_SYSTEM
-#include <sys/ioctl.h>
-#endif /* ! defined (BSD_SYSTEM) */
-
-#include "systime.h"
-
-#ifndef INCLUDED_FCNTL
-#include <fcntl.h>
-#endif
-#include <ctype.h>
-#include <errno.h>
-#include <setjmp.h>
-#include <sys/stat.h>
-
-#include "charset.h"
-#include "character.h"
-#include "coding.h"
-#include "ccl.h"
-#include "frame.h"
-#include "dispextern.h"
-#include "fontset.h"
-#include "termhooks.h"
-#include "termopts.h"
-#include "termchar.h"
-#include "emacs-icon.h"
-#include "disptab.h"
-#include "buffer.h"
-#include "window.h"
-#include "keyboard.h"
-#include "intervals.h"
-#include "process.h"
-#include "atimer.h"
-#include "keymap.h"
-
-
-#ifdef USE_X_TOOLKIT
-#include <X11/Shell.h>
-#endif
-#include <X11/extensions/Xcomposite.h>
-#include <X11/extensions/Xrender.h>
-#include <cairo.h>
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#endif
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
-#include "gtkutil.h"
-#include "font.h"
-#endif /* HAVE_X_WINDOWS */
-
-#include <gtk/gtk.h>
-#include <gdk/gdk.h>
-
-#ifdef HAVE_GTK3
-//for gtk3; sockets and plugs
-#include <gtk/gtkx.h>
-#include <gtk/gtkscrolledwindow.h>
-#include "emacsgtkfixed.h"
-#endif
-
-#include <wchar.h>
-
-#ifdef HAVE_WEBKIT_OSR
-#include <webkit/webkitwebview.h>
-#include <webkit/webkitwebplugindatabase.h>
-#include <webkit/webkitwebplugin.h>
-#include <webkit/webkitglobals.h>
-#include <webkit/webkitwebnavigationaction.h>
-#include <webkit/webkitdownload.h>
-#include <webkit/webkitwebpolicydecision.h>
-#endif
-
-//for GIR
-#include <girepository.h>
-
-#include "xwidget.h"
-
-//TODO embryo of lisp allocators for xwidgets
-//TODO xwidget* should be Lisp_xwidget*
-struct xwidget*
-allocate_xwidget (void)
-{
- return ALLOCATE_PSEUDOVECTOR (struct xwidget, height, PVEC_XWIDGET);
-}
-
-//TODO xwidget_view* should be Lisp_xwidget_view*
-struct xwidget_view*
-allocate_xwidget_view (void)
-{
- return ALLOCATE_PSEUDOVECTOR (struct xwidget_view, redisplayed, PVEC_XWIDGET_VIEW);
-}
-#define XSETXWIDGET(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_XWIDGET))
-#define XSETXWIDGET_VIEW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_XWIDGET_VIEW))
-
-struct xwidget_view* xwidget_view_lookup(struct xwidget* xw, struct window *w);
-Lisp_Object xwidget_spec_value ( Lisp_Object spec, Lisp_Object key, int *found);
-gboolean offscreen_damage_event (GtkWidget *widget, GdkEvent *event, gpointer data);
-void webkit_osr_document_load_finished_callback (WebKitWebView *webkitwebview,
- WebKitWebFrame *arg1,
- gpointer user_data);
-gboolean webkit_osr_download_callback (WebKitWebView *webkitwebview,
- WebKitDownload *arg1,
- gpointer data);
-
-gboolean webkit_osr_mime_type_policy_typedecision_requested_callback(WebKitWebView *webView,
- WebKitWebFrame *frame,
- WebKitNetworkRequest *request,
- gchar *mimetype,
- WebKitWebPolicyDecision *policy_decision,
- gpointer user_data);
-
-gboolean webkit_osr_new_window_policy_decision_requested_callback(WebKitWebView *webView,
- WebKitWebFrame *frame,
- WebKitNetworkRequest *request,
- WebKitWebNavigationAction *navigation_action,
- WebKitWebPolicyDecision *policy_decision,
- gpointer user_data);
-
-
-gboolean webkit_osr_navigation_policy_decision_requested_callback(WebKitWebView *webView,
- WebKitWebFrame *frame,
- WebKitNetworkRequest *request,
- WebKitWebNavigationAction *navigation_action,
- WebKitWebPolicyDecision *policy_decision,
- gpointer user_data);
-
-GtkWidget* xwgir_create(char* class, char* namespace);
-
-
-
-static void
-send_xembed_ready_event (struct xwidget* xw, int xembedid);
-DEFUN ("make-xwidget", Fmake_xwidget, Smake_xwidget, 7, 8, 0,
- doc: /* Make an xwidget from BEG to END of TYPE.
-
-If BUFFER is nil it uses the current buffer. If BUFFER is a string and
-no such buffer exists, it is created.
-
-TYPE is a symbol which can take one of the following values:
-- Button
-- ToggleButton
-- slider
-- socket
-- socket-osr
-- cairo
-*/
- )
- (Lisp_Object beg, Lisp_Object end,
- Lisp_Object type,
- Lisp_Object title,
- Lisp_Object width, Lisp_Object height,
- Lisp_Object data,
- Lisp_Object buffer)
-{
- //should work a bit like "make-button"(make-button BEG END &rest PROPERTIES)
- // arg "type" and fwd should be keyword args eventually
- //(make-xwidget 3 3 'button "oei" 31 31 nil)
- //(xwidget-info (car xwidget-list))
- struct xwidget* xw = allocate_xwidget();
- Lisp_Object val;
- xw->type = type;
- xw->title = title;
- if (NILP (buffer))
- buffer = Fcurrent_buffer(); // no need to gcpro because Fcurrent_buffer doesn't call Feval/eval_sub.
- else
- buffer = Fget_buffer_create (buffer);
- xw->buffer = buffer;
-
- xw->height = XFASTINT(height);
- xw->width = XFASTINT(width);
- xw->kill_without_query = 0;
- XSETXWIDGET (val, xw); // set the vectorlike_header of VAL with the correct value
- Vxwidget_list = Fcons (val, Vxwidget_list);
- xw->widgetwindow_osr = NULL;
- xw->widget_osr = NULL;
- xw->plist = Qnil;
-
-
-
-
-#ifdef HAVE_WEBKIT_OSR
- /* DIY mvc. widget is rendered offscreen,
- later bitmap copied to the views.
- */
- if (EQ(xw->type, Qwebkit_osr)||
- EQ(xw->type, Qsocket_osr)||
- (!NILP (Fget(xw->type, QCxwgir_class)))) {
- block_input();
- xw->widgetwindow_osr = gtk_offscreen_window_new ();
- gtk_window_resize(GTK_WINDOW(xw->widgetwindow_osr), xw->width, xw->height);
- xw->widgetscrolledwindow_osr = NULL; //webkit osr is the only scrolled component atm
-
- if (EQ(xw->type, Qwebkit_osr)){
- xw->widgetscrolledwindow_osr = gtk_scrolled_window_new(NULL, NULL);
- gtk_scrolled_window_set_min_content_height(GTK_SCROLLED_WINDOW(xw->widgetscrolledwindow_osr ),xw->height);
- gtk_scrolled_window_set_min_content_width(GTK_SCROLLED_WINDOW(xw->widgetscrolledwindow_osr ),xw->width);
- gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(xw->widgetscrolledwindow_osr ), GTK_POLICY_ALWAYS, GTK_POLICY_ALWAYS);
-
- xw->widget_osr=webkit_web_view_new();
- gtk_container_add(GTK_CONTAINER(xw->widgetscrolledwindow_osr ), GTK_WIDGET( WEBKIT_WEB_VIEW(xw->widget_osr)));
- }
- if(EQ(xw->type, Qsocket_osr))
- xw->widget_osr = gtk_socket_new();
- if(!NILP (Fget(xw->type, QCxwgir_class)))
- xw->widget_osr = xwgir_create(SDATA(Fcar(Fcdr(Fget(xw->type, QCxwgir_class)))),
- SDATA(Fcar(Fget(xw->type, QCxwgir_class))));
-
- gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width, xw->height);
-
- if (EQ(xw->type, Qwebkit_osr)){
- gtk_container_add (GTK_CONTAINER (xw->widgetwindow_osr), xw->widgetscrolledwindow_osr);
- }else{
- gtk_container_add (GTK_CONTAINER (xw->widgetwindow_osr), xw->widget_osr);
- }
-
- gtk_widget_show (xw->widget_osr);
- gtk_widget_show (xw->widgetwindow_osr);
- gtk_widget_show (xw->widgetscrolledwindow_osr);
-
- /* store some xwidget data in the gtk widgets for convenient retrieval in the event handlers. */
- g_object_set_data (G_OBJECT (xw->widget_osr), XG_XWIDGET, (gpointer) (xw));
- g_object_set_data (G_OBJECT (xw->widgetwindow_osr), XG_XWIDGET, (gpointer) (xw));
-
- /* signals */
- if (EQ(xw->type, Qwebkit_osr)) {
- g_signal_connect (G_OBJECT (xw->widget_osr),
- "document-load-finished",
- G_CALLBACK (webkit_osr_document_load_finished_callback),
- xw);
-
- g_signal_connect (G_OBJECT (xw->widget_osr),
- "download-requested",
- G_CALLBACK (webkit_osr_download_callback),
- xw);
-
- g_signal_connect (G_OBJECT (xw->widget_osr),
- "mime-type-policy-decision-requested",
- G_CALLBACK (webkit_osr_mime_type_policy_typedecision_requested_callback),
- xw);
-
- g_signal_connect (G_OBJECT (xw->widget_osr),
- "new-window-policy-decision-requested",
- G_CALLBACK (webkit_osr_new_window_policy_decision_requested_callback),
- xw);
-
- g_signal_connect (G_OBJECT (xw->widget_osr),
- "navigation-policy-decision-requested",
- G_CALLBACK (webkit_osr_navigation_policy_decision_requested_callback),
- xw);
- }
-
- if (EQ(xw->type, Qsocket_osr)) {
- send_xembed_ready_event (xw, gtk_socket_get_id (GTK_SOCKET (xw->widget_osr)));
- //gtk_widget_realize(xw->widget);
- }
-
-
- unblock_input();
-
- }
-#endif /* HAVE_WEBKIT_OSR */
-
- return val;
-}
-
-DEFUN ("get-buffer-xwidgets", Fget_buffer_xwidgets, Sget_buffer_xwidgets, 1, 1, 0,
- doc: /* Return a list of xwidgets associated with BUFFER.
-BUFFER may be a buffer or the name of one.
- */
- )
- (Lisp_Object buffer)
-{
- Lisp_Object xw, tail, xw_list;
-
- if (NILP (buffer)) return Qnil;
- buffer = Fget_buffer (buffer);
- if (NILP (buffer)) return Qnil;
-
- xw_list = Qnil;
-
- for (tail = Vxwidget_list; CONSP (tail); tail = XCDR (tail))
- {
- xw = XCAR (tail);
- if (XWIDGETP (xw) && EQ (Fxwidget_buffer (xw), buffer))
- xw_list = Fcons (xw, xw_list);
- }
- return xw_list;
-}
-
-int
-xwidget_hidden(struct xwidget_view *xv)
-{
- return xv->hidden;
-}
-
-
-static void
-buttonclick_handler (GtkWidget * widget, gpointer data)
-{
- Lisp_Object xwidget_view, xwidget;
- XSETXWIDGET_VIEW (xwidget_view, (struct xwidget_view *) data);
- xwidget = Fxwidget_view_model (xwidget_view);
-
- struct input_event event;
- Lisp_Object frame = Fwindow_frame (Fxwidget_view_window (xwidget_view));
- struct frame *f = XFRAME (frame);
- printf ("button clicked xw:%d '%s'\n", XXWIDGET (xwidget), XXWIDGET (xwidget)->title);
-
- EVENT_INIT (event);
- event.kind = XWIDGET_EVENT;
-
- event.frame_or_window = frame;
-
- event.arg = Qnil;
- event.arg = Fcons (xwidget, event.arg);
- event.arg = Fcons (intern ("buttonclick"), event.arg);
-
- kbd_buffer_store_event (&event);
-}
-
-
-static void
-send_xembed_ready_event (struct xwidget* xw, int xembedid)
-{
- Lisp_Object xw_lo;
- XSETXWIDGET(xw_lo, xw);
- struct input_event event;
- EVENT_INIT (event);
- event.kind = XWIDGET_EVENT;
- event.frame_or_window = Qnil; //frame; //how to get the frame here? //TODO i store it in the xwidget now
-
- event.arg = Qnil;
- event.arg = Fcons (make_number (xembedid), event.arg);
- event.arg = Fcons (xw_lo, event.arg);
- event.arg = Fcons (intern ("xembed-ready"), event.arg);
-
-
- kbd_buffer_store_event (&event);
-
-}
-
-void
-xwidget_show_view (struct xwidget_view *xv)
-{
- xv->hidden = 0;
- gtk_widget_show(xv->widgetwindow);
- gtk_fixed_move (GTK_FIXED (xv->emacswindow), xv->widgetwindow, xv->x + xv->clip_left, xv->y + xv->clip_top); //TODO refactor
-}
-
-
-/* hide an xvidget view */
-void
-xwidget_hide_view (struct xwidget_view *xv)
-{
- xv->hidden = 1;
- //gtk_widget_hide(xw->widgetwindow);
- gtk_fixed_move (GTK_FIXED (xv->emacswindow), xv->widgetwindow,
- 10000, 10000);
-}
-
-
-void
-xwidget_plug_added(GtkSocket *socket,
- gpointer user_data)
-{
- //hmm this doesnt seem to get called for foreign windows
- printf("xwidget_plug_added\n");
-}
-
-gboolean
-xwidget_plug_removed(GtkSocket *socket,
- gpointer user_data)
-{
- printf("xwidget_plug_removed\n");
- return TRUE; /* dont run the default handler because that kills the socket and we want to reuse it*/
-}
-
-
-void
-xwidget_slider_changed (GtkRange *range,
- gpointer user_data)
-{
- //slider value changed. change value of siblings
- //correspondingly. but remember that changing value will again
- //trigger signal
-
- //TODO MVC view storage wont be an array futureish so the loop needs to change eventually
- //TODO MVC it would be nice if this code could be reusable but, alas, C is not a functional language
- //issues are:
- // - the type of the controllers value (double, boolean etc)
- // - the getter and setter (but they can be func pointers)
- // a behemoth macro is always an option.
- double v=gtk_range_get_value(range);
- struct xwidget_view* xvp = g_object_get_data (G_OBJECT (range), XG_XWIDGET_VIEW);
- struct xwidget_view* xv;
-
- printf("slider changed val:%f\n", v);
-
- for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); tail = XCDR (tail))
- {
- if (XWIDGET_VIEW_P (XCAR (tail))) {
- xv = XXWIDGET_VIEW (XCAR (tail));
- if (EQ (xvp->model, xv->model)) {
- //block sibling views signal handlers
- g_signal_handler_block(xv->widget, xv->handler_id);
-
- //set values of sibling views and unblock
- gtk_range_set_value(GTK_RANGE(xv->widget), v);
- g_signal_handler_unblock(xv->widget,xv->handler_id);
- }
- }
- }
-}
-
-
-/* when the off-screen webkit master view changes this signal is called.
- it copies the bitmap from the off-screen webkit instance */
-gboolean
-offscreen_damage_event (GtkWidget *widget, GdkEvent *event, gpointer data)
-{
- //TODO this is wrong! should just queu a redraw of onscreen widget
- gtk_widget_queue_draw (GTK_WIDGET (data));
- return FALSE;
-}
-
-void
-store_xwidget_event_string(struct xwidget* xw, char* eventname, const char* eventstr)
-{
- //refactor attempt
- struct input_event event;
- Lisp_Object xwl;
- XSETXWIDGET(xwl,xw);
- EVENT_INIT (event);
- event.kind = XWIDGET_EVENT;
- event.frame_or_window = Qnil; //frame; //how to get the frame here? //TODO i store it in the xwidget now
-
- event.arg = Qnil;
- event.arg = Fcons (build_string(eventstr), event.arg); //string so dont intern
- event.arg = Fcons (xwl, event.arg); //TODO
- event.arg = Fcons (intern (eventname), event.arg);//interning should be ok
- kbd_buffer_store_event (&event);
-
-}
-
-//TODO deprecated, use load-status
-void
-webkit_osr_document_load_finished_callback (WebKitWebView *webkitwebview,
- WebKitWebFrame *arg1,
- gpointer data)
-{
- //TODO this event sending code should be refactored
- // struct xwidget *xw = (struct xwidget *) data;
- struct xwidget* xw = (struct xwidget*) g_object_get_data (G_OBJECT (webkitwebview), XG_XWIDGET);
- printf("webkit finished loading\n");
-
- store_xwidget_event_string(xw,
- "document-load-finished", "");
-}
-
-gboolean
-webkit_osr_download_callback (WebKitWebView *webkitwebview,
- WebKitDownload *arg1,
- gpointer data)
-{
- //TODO this event sending code should be refactored
- struct input_event event;
- // struct xwidget *xw = (struct xwidget *) data;
- struct xwidget* xw = (struct xwidget*) g_object_get_data (G_OBJECT (webkitwebview), XG_XWIDGET);
- printf("download requested %s\n", webkit_download_get_uri (arg1));
-
-
- printf("webkit finished loading\n");
-
- store_xwidget_event_string(xw, "download-requested", webkit_download_get_uri (arg1));
-
- return FALSE;
-}
-
-gboolean
-webkit_osr_mime_type_policy_typedecision_requested_callback(WebKitWebView *webView,
- WebKitWebFrame *frame,
- WebKitNetworkRequest *request,
- gchar *mimetype,
- WebKitWebPolicyDecision *policy_decision,
- gpointer user_data)
-{
- printf("mime policy requested\n");
- // this function makes webkit send a download signal for all unknown mime types
- // TODO defer the decision to lisp, so that its possible to make Emacs handle text mime for instance
- if(!webkit_web_view_can_show_mime_type(webView, mimetype)){
- webkit_web_policy_decision_download (policy_decision);
- return TRUE;
- }else{
- return FALSE;
- }
-}
-
-
-gboolean
-webkit_osr_new_window_policy_decision_requested_callback(WebKitWebView *webView,
- WebKitWebFrame *frame,
- WebKitNetworkRequest *request,
- WebKitWebNavigationAction *navigation_action,
- WebKitWebPolicyDecision *policy_decision,
- gpointer user_data)
-{
- struct xwidget* xw = (struct xwidget*) g_object_get_data (G_OBJECT (webView), XG_XWIDGET);
- printf("webkit_osr_new_window_policy_decision_requested_callback %s\n",
- webkit_web_navigation_action_get_original_uri (navigation_action));
-
- store_xwidget_event_string(xw, "new-window-policy-decision-requested", webkit_web_navigation_action_get_original_uri (navigation_action)
- );
- return FALSE;
-}
-
-gboolean
-webkit_osr_navigation_policy_decision_requested_callback(WebKitWebView *webView,
- WebKitWebFrame *frame,
- WebKitNetworkRequest *request,
- WebKitWebNavigationAction *navigation_action,
- WebKitWebPolicyDecision *policy_decision,
- gpointer user_data)
-{
- struct xwidget* xw = (struct xwidget*) g_object_get_data (G_OBJECT (webView), XG_XWIDGET);
- printf("webkit_osr_navigation_policy_decision_requested_callback %s\n",
- webkit_web_navigation_action_get_original_uri (navigation_action));
- store_xwidget_event_string(xw, "navigation-policy-decision-requested", webkit_web_navigation_action_get_original_uri (navigation_action)
- );
- return FALSE;
-}
-
-//for gtk3 offscreen rendered widgets
-gboolean
-xwidget_osr_draw_callback (GtkWidget *widget, cairo_t *cr, gpointer data)
-{
- struct xwidget* xw = (struct xwidget*) g_object_get_data (G_OBJECT (widget), XG_XWIDGET);
- struct xwidget_view* xv = (struct xwidget_view*) g_object_get_data (G_OBJECT (widget), XG_XWIDGET_VIEW);
-
- cairo_rectangle(cr, 0,0, xv->clip_right, xv->clip_bottom);//xw->width, xw->height);
- cairo_clip(cr);
-
- //
- if(xw->widgetscrolledwindow_osr != NULL)
- gtk_widget_draw (xw->widgetscrolledwindow_osr, cr);
- else
- gtk_widget_draw (xw->widget_osr, cr);
- return FALSE;
-}
-
-GtkWidget* xwgir_create_debug;
-
-
-
-gboolean
-xwidget_osr_event_forward (GtkWidget *widget,
- GdkEvent *event,
- gpointer user_data)
-{
- /* copy events that arrive at the outer widget to the offscreen widget */
- struct xwidget* xw = (struct xwidget*) g_object_get_data (G_OBJECT (widget), XG_XWIDGET);
- GdkEvent* eventcopy = gdk_event_copy(event);
- eventcopy->any.window = gtk_widget_get_window(xw->widget_osr);// works
-
- /* printf("xwidget_osr_event_forward redirect event to window:%d\n", ((GdkEventAny*)eventcopy)->window); */
- /* printf("A type:%d x:%f y:%f \n", event->type, event->button.x, event->button.y); */
- /* printf("B type:%d x:%f y:%f \n", eventcopy->type, eventcopy->button.x, eventcopy->button.y); */
- //gtk_button_get_event_window(xwgir_create_debug);
- gtk_main_do_event(eventcopy); //TODO this will leak events. they should be deallocated later, perhaps in xwgir_event_callback
- return TRUE; //dont propagate this event furter
-}
-
-GIRepository *girepository ;
-
-DEFUN ("xwgir-require-namespace", Fxwgir_require_namespace, Sxwgir_require_namespace, 2,2,0,
- doc: /* Require a GObject Introspection namespace.
- This must be done for all namespaces we want to use, before using other xwgir functions.*/)
- (Lisp_Object lnamespace, Lisp_Object lnamespace_version)
-{
- char* namespace = SDATA(lnamespace);
- char* namespace_version = SDATA(lnamespace_version);
- GError *error = NULL;
-
- girepository = g_irepository_get_default();
- g_irepository_require(girepository, namespace, namespace_version, 0, &error);
- if (error) {
- g_error("ERROR: %s\n", error->message);
- return Qnil;
- }
- return Qt;
-}
-
-GtkWidget* xwgir_create(char* class, char* namespace){
- //TODO this is more or less the same as xwgir-call-method, so should be refactored
- //create a gtk widget, given its name
- //find the constructor
- //call it
- //also figure out how to pass args
-
- GError *error = NULL;
- GIArgument return_value;
-
- GIObjectInfo* obj_info = g_irepository_find_by_name(girepository, namespace, class);
- GIFunctionInfo* f_info = g_object_info_find_method (obj_info, "new");
- g_function_info_invoke(f_info,
- NULL, 0,
- NULL, 0,
- &return_value,
- NULL);
- xwgir_create_debug = return_value.v_pointer;
- return return_value.v_pointer;
-
-}
-
-int
-xwgir_convert_lisp_to_gir_arg(GIArgument* giarg,
- GIArgInfo* arginfo,
- Lisp_Object lisparg )
-{
-
- GITypeTag tag;
- gboolean is_pointer;
- gboolean is_enum;
- tag = g_type_info_get_tag (g_arg_info_get_type (arginfo));
-
- switch (tag)
- {
- case GI_TYPE_TAG_BOOLEAN:
- giarg->v_boolean = XFASTINT(lisparg);
- break;
- case GI_TYPE_TAG_INT8:
- giarg->v_int8 = XFASTINT(lisparg);
- break;
- case GI_TYPE_TAG_UINT8:
- giarg->v_uint8 = XFASTINT(lisparg);
- break;
- case GI_TYPE_TAG_INT16:
- giarg->v_int16 = XFASTINT(lisparg);
- break;
- case GI_TYPE_TAG_UINT16:
- giarg->v_uint16 = XFASTINT(lisparg);
- break;
- case GI_TYPE_TAG_INT32:
- giarg->v_int32 = XFASTINT(lisparg);
- break;
- case GI_TYPE_TAG_UINT32:
- giarg->v_uint32 = XFASTINT(lisparg);
- break;
-
- case GI_TYPE_TAG_INT64:
- giarg->v_int64 = XFASTINT(lisparg);
- break;
- case GI_TYPE_TAG_UINT64:
- giarg->v_uint64 = XFASTINT(lisparg);
- break;
-
-
- case GI_TYPE_TAG_FLOAT:
- giarg->v_float = XFLOAT_DATA(lisparg);
- break;
-
- case GI_TYPE_TAG_DOUBLE:
- giarg->v_double = XFLOAT_DATA(lisparg);
- break;
-
- case GI_TYPE_TAG_UTF8:
- case GI_TYPE_TAG_FILENAME:
- //giarg->v_string = SDATA(lisparg);
- giarg->v_pointer = SDATA(lisparg);
- break;
-
- case GI_TYPE_TAG_ARRAY:
- case GI_TYPE_TAG_GLIST:
- case GI_TYPE_TAG_GSLIST:
- case GI_TYPE_TAG_GHASH:
- case GI_TYPE_TAG_ERROR:
- case GI_TYPE_TAG_INTERFACE:
- case GI_TYPE_TAG_VOID:
- case GI_TYPE_TAG_UNICHAR:
- case GI_TYPE_TAG_GTYPE:
- //?? i dont know how to handle these yet TODO
- printf("failed in my lisp to gir arg conversion duties. sob!\n");
- return -1;
- break;
- }
- return 0;
-}
-
-#if 0
-void
-refactor_attempt(){
- //this methhod should be called from xwgir-xwidget-call-method and from xwgir xwidget construction
- char* class = SDATA(Fcar(Fcdr(Fget(xw->type, QCxwgir_class))));
-
- GIObjectInfo* obj_info = g_irepository_find_by_name(girepository, namespace, class);
- GIFunctionInfo* f_info = g_object_info_find_method (obj_info, SDATA(method));
-
- //loop over args, convert from lisp to primitive type, given arg introspection data
- //TODO g_callable_info_get_n_args(f_info) should match
- int argscount = XFASTINT(Flength(arguments));
- if(argscount != g_callable_info_get_n_args(f_info)){
- printf("xwgir call method arg count doesn match! \n");
- return Qnil;
- }
- int i;
- for (i = 1; i < argscount + 1; ++i)
- {
- xwgir_convert_lisp_to_gir_arg(&in_args[i], g_callable_info_get_arg(f_info, i - 1), Fnth(i - 1, arguments));
- }
-
- in_args[0].v_pointer = widget;
- if(g_function_info_invoke(f_info,
- in_args, argscount + 1,
- NULL, 0,
- &return_value,
- &error)) {
- //g_error("ERROR: %s\n", error->message);
- printf("invokation error\n");
- return Qnil;
- }
- return Qt;
-}
-#endif /* 0 */
-
-DEFUN ("xwgir-xwidget-call-method", Fxwgir_xwidget_call_method, Sxwgir_xwidget_call_method, 3, 3, 0,
- doc: /* Call Xwidget object method using GObject Introspection.
- XWIDGET is the xwidget instance to act upon.
- METHOD is the Gobject intrsopsection method name.
- ARGUMENTS is a list of arguments for the call. They will be converted to GObject types from Lisp types.
- */)
- (Lisp_Object xwidget, Lisp_Object method, Lisp_Object arguments)
-{
- CHECK_XWIDGET (xwidget);
- GError *error = NULL;
- GIArgument return_value;
- GIArgument in_args[20];
-
-
- struct xwidget* xw;
- if (NILP (xwidget)) { printf("ERROR xwidget nil\n"); return Qnil; };
- xw = XXWIDGET(xwidget);
- if(NULL == xw) printf("ERROR xw is 0\n");
- char* namespace = SDATA(Fcar(Fget(xw->type, QCxwgir_class)));
- //we need the concrete widget, which happens in 2 ways depending on OSR or not TODO
- GtkWidget* widget = NULL;
- if(NULL == xw->widget_osr) {
- widget = xwidget_view_lookup (xw, XWINDOW(FRAME_SELECTED_WINDOW (SELECTED_FRAME ()))) -> widget;
- } else {
- widget = xw->widget_osr;
- }
-
- //char* class = SDATA(SYMBOL_NAME(xw->type)); //this works but is unflexible
- //figure out the class from the widget instead
- /* printf("type class: %s %s\n", G_OBJECT_TYPE_NAME(widget), G_OBJECT_CLASS_NAME(G_OBJECT_GET_CLASS(widget))); */
- /* char* class = G_OBJECT_TYPE_NAME(widget); //gives "GtkButton"(I want "Button") */
- /* class += strlen(namespace); //TODO check for corresponding api method. but this seems to work. */
-
- char* class = SDATA(Fcar(Fcdr(Fget(xw->type, QCxwgir_class))));
-
- GIObjectInfo* obj_info = g_irepository_find_by_name(girepository, namespace, class);
- GIFunctionInfo* f_info = g_object_info_find_method (obj_info, SDATA(method));
-
- //loop over args, convert from lisp to primitive type, given arg introspection data
- //TODO g_callable_info_get_n_args(f_info) should match
- int argscount = XFASTINT(Flength(arguments));
- if(argscount != g_callable_info_get_n_args(f_info)){
- printf("xwgir call method arg count doesn match! \n");
- return Qnil;
- }
- int i;
- Lisp_Object n;
- for (i = 1; i < argscount + 1; ++i)
- {
- XSETFASTINT (n, i - 1);
- xwgir_convert_lisp_to_gir_arg(&in_args[i], g_callable_info_get_arg(f_info, i - 1), Fnth(n, arguments));
- }
-
- in_args[0].v_pointer = widget;
- if(g_function_info_invoke(f_info,
- in_args, argscount + 1,
- NULL, 0,
- &return_value,
- &error)) {
- //g_error("ERROR: %s\n", error->message);
- printf("invokation error\n");
- return Qnil;
- }
- return Qt;
-}
-
- void
-to_child (GtkWidget *bin,
- double widget_x,
- double widget_y,
- double *x_out,
- double *y_out)
-{
- *x_out = widget_x;
- *y_out = widget_y;
-}
-
-
-GdkWindow *
-offscreen_pick_embedded_child (GdkWindow *window,
- double x,
- double y,
- gpointer *data)
-{
- //in this simple case we assume the window contains a single widget. easy.
- //but then we get the problem that the widget cant be embedded in several windows
- return gtk_widget_get_window (GTK_WIDGET (data));
-}
-
-void
-offscreen_to_embedder (GdkWindow *window,
- gdouble offscreen_x,
- gdouble offscreen_y,
- gpointer embedder_x,
- gpointer embedder_y,
- gpointer data)
-{
- * (gdouble *) embedder_x = offscreen_x;
- * (gdouble *) embedder_y = offscreen_y;
-}
-
-void
-offscreen_from_embedder (GdkWindow *window,
- gdouble embedder_x,
- gdouble embedder_y,
- gpointer offscreen_x,
- gpointer offscreen_y,
- gpointer user_data)
-{
- * (gdouble *) offscreen_x = embedder_x;
- * (gdouble *) offscreen_y = embedder_y;
-}
-
-gboolean
-xwidget_osr_event_set_embedder (GtkWidget *widget,
- GdkEvent *event,
- gpointer data)
-{
- struct xwidget_view *xv = (struct xwidget_view *) data;
- struct xwidget *xww = XXWIDGET (xv->model);
- printf("gdk_offscreen_window_set_embedder %d %d\n",
- GDK_IS_WINDOW(gtk_widget_get_window (xww->widget_osr)),
- GDK_IS_WINDOW(gtk_widget_get_window (GTK_WIDGET (xv->widget))));
- gdk_offscreen_window_set_embedder (gtk_widget_get_window (xww->widgetwindow_osr),
- gtk_widget_get_window (xv->widget));
-}
-
-
-/* initializes and does initial placement of an xwidget view on screen */
-struct xwidget_view*
-xwidget_init_view (struct xwidget *xww,
- struct glyph_string *s,
- int x, int y)
-{
- struct xwidget_view *xv = allocate_xwidget_view();
- Lisp_Object val;
- GdkColor color;
-
- XSETXWIDGET_VIEW (val, xv) ;
- Vxwidget_view_list = Fcons (val, Vxwidget_view_list);
-
- XSETWINDOW(xv->w, s->w);
- XSETXWIDGET(xv->model, xww);
-
- //widget creation
- if(EQ(xww->type, Qbutton))
- {
- xv->widget = gtk_button_new_with_label (XSTRING(xww->title)->data);
- g_signal_connect (G_OBJECT (xv->widget), "clicked",
- G_CALLBACK (buttonclick_handler), xv); // the view rather than the model
- } else if (EQ(xww->type, Qtoggle)) {
- xv->widget = gtk_toggle_button_new_with_label (XSTRING(xww->title)->data);
- //xv->widget = gtk_entry_new ();//temp hack to experiment with key propagation TODO entry widget is useful for testing
- } else if (EQ(xww->type, Qsocket)) {
- xv->widget = gtk_socket_new ();
- g_signal_connect_after(xv->widget, "plug-added", G_CALLBACK(xwidget_plug_added), "plug added");
- g_signal_connect_after(xv->widget, "plug-removed", G_CALLBACK(xwidget_plug_removed), "plug removed");
- //TODO these doesnt help
- gtk_widget_add_events(xv->widget, GDK_KEY_PRESS);
- gtk_widget_add_events(xv->widget, GDK_KEY_RELEASE);
- } else if (EQ(xww->type, Qslider)) {
- xv->widget =
- //gtk_hscale_new (GTK_ADJUSTMENT(gtk_adjustment_new (0.0, 0.0, 100.0, 1.0, 10.0, 10.0)));
- gtk_hscale_new_with_range ( 0.0, 100.0, 10.0);
- gtk_scale_set_draw_value (GTK_SCALE (xv->widget), FALSE); //i think its emacs role to show text and stuff, so disable the widgets own text
- xv->handler_id = g_signal_connect_after(xv->widget, "value-changed", G_CALLBACK(xwidget_slider_changed), "slider changed");
- } else if (EQ(xww->type, Qcairo)) {
- //Cairo view
- //uhm cairo is differentish in gtk 3.
- //gdk_cairo_create (gtk_widget_get_window (FRAME_GTK_WIDGET (s->f)));
- xv->widget = gtk_drawing_area_new();
- g_signal_connect (G_OBJECT ( xv->widget), "draw",
- G_CALLBACK (xwidget_osr_draw_callback), NULL);
-
- } else if (EQ(xww->type, Qwebkit_osr)||
- EQ(xww->type, Qsocket_osr)||
- (!NILP (Fget(xww->type, QCxwgir_class))))//xwgir widgets are OSR
- {
- printf("osr init:%s\n",SDATA(SYMBOL_NAME(xww->type)));
- xv->widget = gtk_drawing_area_new();
- gtk_widget_set_app_paintable ( xv->widget, TRUE); //because expose event handling
- gtk_widget_add_events(xv->widget, GDK_ALL_EVENTS_MASK);
-
- /* Draw the view on damage-event */
- g_signal_connect (G_OBJECT (xww->widgetwindow_osr), "damage-event",
- G_CALLBACK (offscreen_damage_event), xv->widget);
-
- if (EQ(xww->type, Qwebkit_osr)){
- /* ///xwgir debug */
- /* //forward events. this isnt compatible with the set_embedded strategy */
- g_signal_connect (G_OBJECT ( xv->widget), "button-press-event",
- G_CALLBACK (xwidget_osr_event_forward), NULL);
- g_signal_connect (G_OBJECT ( xv->widget), "button-release-event",
- G_CALLBACK (xwidget_osr_event_forward), NULL);
- g_signal_connect (G_OBJECT ( xv->widget), "motion-notify-event",
- G_CALLBACK (xwidget_osr_event_forward), NULL);
- }else{
- //xwgir debug , orthogonal to forwarding
- g_signal_connect (G_OBJECT (xv->widget), "enter-notify-event",
- G_CALLBACK (xwidget_osr_event_set_embedder), xv);
- }
-
- //draw
- g_signal_connect (G_OBJECT (xv->widget), "draw",
- G_CALLBACK (xwidget_osr_draw_callback), NULL);
-
- }
- //else return NULL;
-
- //widget realization
- //make container widget 1st, and put the actual widget inside the container
- //later, drawing should crop container window if necessary to handle case where xwidget
- //is partially obscured by other emacs windows
- //other containers than gtk_fixed where explored, but gtk_fixed had the most predictable behaviour so far.
- xv->emacswindow = FRAME_GTK_WIDGET (s->f);
- xv->widgetwindow = gtk_fixed_new ();
- gtk_widget_set_has_window(xv->widgetwindow, TRUE);
- gtk_container_add (GTK_CONTAINER (xv->widgetwindow), xv->widget);
-
- //store some xwidget data in the gtk widgets
- g_object_set_data (G_OBJECT (xv->widget), XG_FRAME_DATA, (gpointer) (s->f)); //the emacs frame
- g_object_set_data (G_OBJECT (xv->widget), XG_XWIDGET, (gpointer) (xww)); //the xwidget
- g_object_set_data (G_OBJECT (xv->widget), XG_XWIDGET_VIEW, (gpointer) (xv)); //the xwidget
- g_object_set_data (G_OBJECT (xv->widgetwindow), XG_XWIDGET, (gpointer) (xww)); //the xwidget window
- g_object_set_data (G_OBJECT (xv->widgetwindow), XG_XWIDGET_VIEW, (gpointer) (xv)); //the xwidget window
-
-
- gtk_widget_set_size_request (GTK_WIDGET (xv->widget), xww->width, xww->height);
- gtk_widget_set_size_request (xv->widgetwindow, xww->width, xww->height);
- gtk_fixed_put (GTK_FIXED (FRAME_GTK_WIDGET (s->f)), xv->widgetwindow, x, y);
- xv->x = x; xv->y = y;
- gtk_widget_show_all (xv->widgetwindow);
-
-
-
- //widgettype specific initialization only possible after realization
- if (EQ(xww->type, Qsocket)) {
- printf ("xwid:%d socket id:%x %d\n",
- xww,
- gtk_socket_get_id (GTK_SOCKET (xv->widget)),
- gtk_socket_get_id (GTK_SOCKET (xv->widget)));
- send_xembed_ready_event (xww,
- gtk_socket_get_id (GTK_SOCKET (xv->widget)));
- //gtk_widget_realize(xw->widget);
- }
-
- //////////////////////////////////////////////////////////////
- // xwgir debug
- if (//EQ(xww->type, Qwebkit_osr)|| //TODO should be able to choose compile time which method to use with webkit
- EQ(xww->type, Qsocket_osr)||
- (!NILP (Fget(xww->type, QCxwgir_class))))//xwgir widgets are OSR
- {
- printf("gdk_offscreen_window_set_embedder %d %d\n",
- GDK_IS_WINDOW(gtk_widget_get_window (xww->widget_osr)),
- GDK_IS_WINDOW(gtk_widget_get_window (GTK_WIDGET (xv->widget))));
- // set_embedder needs to be called after xv->widget realization
- gdk_offscreen_window_set_embedder (gtk_widget_get_window (xww->widgetwindow_osr),
- gtk_widget_get_window (xv->widget));
- g_signal_connect (gtk_widget_get_window (xv->widget), "pick-embedded-child",
- G_CALLBACK (offscreen_pick_embedded_child), xww->widgetwindow_osr);
-
- g_signal_connect (gtk_widget_get_window (xww->widgetwindow_osr), "from-embedder",
- G_CALLBACK (offscreen_from_embedder), NULL);
- g_signal_connect (gtk_widget_get_window (xww->widgetwindow_osr), "to-embedder",
- G_CALLBACK (offscreen_to_embedder), NULL);
- }
- ////////////////////////////////////////
-
- return xv;
-}
-
-
-void
-x_draw_xwidget_glyph_string (struct glyph_string *s)
-{
- /*
- this method is called by the redisplay engine and places the xwidget on screen.
- moving and clipping is done here. also view init.
-
- */
- int box_line_hwidth = eabs (s->face->box_line_width);
- int box_line_vwidth = max (s->face->box_line_width, 0);
- int height = s->height;
- struct xwidget *xww = s->xwidget;
- struct xwidget_view *xv = xwidget_view_lookup(xww, s->w);
- int clip_right; int clip_bottom; int clip_top; int clip_left;
-
- int x = s->x;
- int y = s->y + (s->height / 2) - (xww->height / 2);
- int moved=0;
-
- /* We do it here in the display loop because there is no other
- time to know things like window placement etc.
- */
- printf ("xv init for xw %d\n", xww);
- xv = xwidget_init_view (xww, s, x, y);
-
- //calculate clipping, which is used for all manner of onscreen xwidget views
- //each widget border can get clipped by other emacs objects so there are four clipping variables
- clip_right = min (xww->width, WINDOW_RIGHT_EDGE_X (s->w) - x - WINDOW_RIGHT_SCROLL_BAR_AREA_WIDTH(s->w) - WINDOW_RIGHT_FRINGE_WIDTH(s->w));
- clip_left = max (0, WINDOW_LEFT_EDGE_X (s->w) - x + WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH(s->w) + WINDOW_LEFT_FRINGE_WIDTH(s->w));
-
- clip_bottom = min (xww->height, WINDOW_BOTTOM_EDGE_Y (s->w) - WINDOW_MODE_LINE_HEIGHT (s->w) - y);
- clip_top = max(0, WINDOW_TOP_EDGE_Y(s->w) -y );
-
- //we are conserned with movement of the onscreen area. the area might sit still when the widget actually moves
- //this happens when an emacs window border moves across a widget window
- //so, if any corner of the outer widget clippng window moves, that counts as movement here, even
- //if it looks like no movement happens because the widget sits still inside the clipping area.
- //the widget can also move inside the clipping area, which happens later
- moved = (xv->x + xv->clip_left != x+clip_left)
- || ((xv->y + xv->clip_top)!= (y+clip_top));
- xv->x = x;
- xv->y = y;
- if (moved) //has it moved?
- {
- if (1)//!xwidget_hidden(xv)) //hidden equals not being seen during redisplay
- {
- //TODO should be possible to use xwidget_show_view here
- gtk_fixed_move (GTK_FIXED (FRAME_GTK_WIDGET (s->f)),
- xv->widgetwindow,
- x + clip_left, y + clip_top);
- }
- }
- //clip the widget window if some parts happen to be outside drawable area
- //an emacs window is not a gtk window, a gtk window covers the entire frame
- //cliping might have changed even if we havent actualy moved, we try figure out when we need to reclip for real
- if((xv->clip_right != clip_right)
- || (xv->clip_bottom != clip_bottom)
- || (xv->clip_top != clip_top)
- || (xv->clip_left != clip_left)){
- gtk_widget_set_size_request (xv->widgetwindow, clip_right + clip_left, clip_bottom + clip_top);
- gtk_fixed_move(GTK_FIXED(xv->widgetwindow), xv->widget, -clip_left, -clip_top);
-
- xv->clip_right = clip_right; xv->clip_bottom = clip_bottom; xv->clip_top = clip_top;xv->clip_left = clip_left;
- }
- //if emacs wants to repaint the area where the widget lives, queue a redraw
- //TODO it seems its possible to get out of sync with emacs redraws so emacs bg sometimes shows up instead of xwidget
- //its just a visual glitch though
- if (!xwidget_hidden(xv)){
- gtk_widget_queue_draw (xv->widgetwindow);
- gtk_widget_queue_draw (xv->widget);
- }
-}
-
-
-#ifdef HAVE_WEBKIT_OSR
-
-//FUGLY macro that checks WEBKIT_IS_WEB_VIEW(xw->widget_osr) first
-#define WEBKIT_FN_INIT() \
- struct xwidget* xw; \
- CHECK_XWIDGET (xwidget); \
- if(NILP (xwidget)) {printf("ERROR xwidget nil\n"); return Qnil;}; \
- xw = XXWIDGET(xwidget); \
- if(NULL == xw) printf("ERROR xw is 0\n"); \
- if((NULL == xw->widget_osr) || !WEBKIT_IS_WEB_VIEW(xw->widget_osr)){ \
- printf("ERROR xw->widget_osr does not hold a webkit instance\n");\
- return Qnil;\
- };
-
-
-DEFUN ("xwidget-webkit-goto-uri", Fxwidget_webkit_goto_uri, Sxwidget_webkit_goto_uri,
- 2, 2, 0,
- doc: /* Make the webkit instance referenced by XWIDGET browse URI. */)
- (Lisp_Object xwidget, Lisp_Object uri)
-{
- WEBKIT_FN_INIT();
- CHECK_STRING(uri);
- webkit_web_view_load_uri ( WEBKIT_WEB_VIEW(xw->widget_osr), SDATA(uri));
- return Qnil;
-}
-
-
-DEFUN ("xwidget-webkit-execute-script", Fxwidget_webkit_execute_script, Sxwidget_webkit_execute_script,
- 2, 2, 0,
- doc: /* webkit exec js.*/)
- (Lisp_Object xwidget, Lisp_Object script)
-{
- WEBKIT_FN_INIT();
- CHECK_STRING(script);
- webkit_web_view_execute_script( WEBKIT_WEB_VIEW(xw->widget_osr), SDATA(script));
- return Qnil;
-}
-
-DEFUN ("xwidget-webkit-get-title", Fxwidget_webkit_get_title, Sxwidget_webkit_get_title,
- 1, 1, 0,
- doc: /* Get the title from the Webkit instance in XWIDGET.
- This can be used to work around the lack of a return value from the exec method.
- */)
- (Lisp_Object xwidget)
-{
- //TODO support multibyte strings
- WEBKIT_FN_INIT();
- const gchar* str=webkit_web_view_get_title( WEBKIT_WEB_VIEW(xw->widget_osr));
- //return make_string_from_bytes(str, wcslen((const wchar_t *)str), strlen(str));
- if(str == 0){
- //TODO maybe return Qnil instead. I suppose webkit returns nullpointer when doc is not properly loaded or something
- printf("xwidget-webkit-get-title null webkit title\n");
- return build_string("");
- }
- return build_string(str);
-}
-
-//TODO missnamed
-DEFUN ("xwidget-disable-plugin-for-mime", Fxwidget_disable_plugin_for_mime , Sxwidget_disable_plugin_for_mime,
- 1,1,0, doc: /* */)
- (Lisp_Object mime)
-{
- WebKitWebPlugin *wp = webkit_web_plugin_database_get_plugin_for_mimetype
- (webkit_get_web_plugin_database(), SDATA(mime));
- if(wp == NULL) return Qnil;
- if(webkit_web_plugin_get_enabled (wp)){
- webkit_web_plugin_set_enabled (wp, FALSE);
- return Qt;
- }
- return Qnil;
-}
-
-
-void
-xwidget_webkit_dom_dump(WebKitDOMNode* parent)
-{
- WebKitDOMNodeList* list;
- int i;
- int length;
- WebKitDOMNode* attribute;
- WebKitDOMNamedNodeMap* attrs;
- WebKitDOMNode* child;
- printf("node:%d type:%d name:%s content:%s\n",
- parent,
- webkit_dom_node_get_node_type(parent),//1 element 3 text 8 comment 2 attribute
- webkit_dom_node_get_local_name(parent),
- webkit_dom_node_get_text_content(parent));
-
- if(webkit_dom_node_has_attributes(parent)){
- attrs = webkit_dom_node_get_attributes(parent);
-
- length = webkit_dom_named_node_map_get_length(attrs);
- for (int i = 0; i < length; i++) {
- attribute = webkit_dom_named_node_map_item(attrs,i);
- printf(" attr node:%d type:%d name:%s content:%s\n",
- attribute,
- webkit_dom_node_get_node_type(attribute),//1 element 3 text 8 comment
- webkit_dom_node_get_local_name(attribute),
- webkit_dom_node_get_text_content(attribute));
- }
- }
- list = webkit_dom_node_get_child_nodes(parent);
- length = webkit_dom_node_list_get_length(list);
-
- for (int i = 0; i < length; i++) {
- child = webkit_dom_node_list_item(list, i);
- //if(webkit_dom_node_has_child_nodes(child))
- xwidget_webkit_dom_dump(child);
- }
-}
-
-
-DEFUN ("xwidget-webkit-dom-dump", Fxwidget_webkit_dom_dump, Sxwidget_webkit_dom_dump,
- 1, 1, 0,
- doc: /*Dump the DOM contained in the webkit instance in XWIDGET.*/)
- (Lisp_Object xwidget)
-{
- WEBKIT_FN_INIT();
- xwidget_webkit_dom_dump(WEBKIT_DOM_NODE(webkit_web_view_get_dom_document( WEBKIT_WEB_VIEW(xw->widget_osr))));
- return Qnil;
-}
-
-
-
-#endif /* HAVE_WEBKIT_OSR */
-
-
-
-DEFUN ("xwidget-resize", Fxwidget_resize, Sxwidget_resize, 3, 3, 0, doc:
- /* Resize XWIDGET.
- NEW_WIDTH NEW_HEIGHT defines the new size.)
- */)
- (Lisp_Object xwidget, Lisp_Object new_width, Lisp_Object new_height)
-{
- CHECK_XWIDGET (xwidget);
- struct xwidget* xw = XXWIDGET(xwidget);
- struct xwidget_view *xv;
- int w, h;
-
- CHECK_NUMBER (new_width);
- CHECK_NUMBER (new_height);
- w = XFASTINT (new_width);
- h = XFASTINT (new_height);
-
-
- printf("resize xwidget %d (%d,%d)->(%d,%d)\n",xw, xw->width,xw->height,w,h);
- xw->width=w;
- xw->height=h;
- //if theres a osr resize it 1st
- if(xw->widget_osr){
- printf("resize xwidget_osr\n");
- //gtk_container_set_resize_mode ( GTK_WINDOW(xw->widgetwindow_osr), GTK_RESIZE_QUEUE);
- //gtk_container_set_resize_mode ( GTK_WINDOW(xw->widget_osr), GTK_RESIZE_QUEUE);
-
-
- //gtk_layout_set_size (GTK_LAYOUT (xw->widgetwindow_osr), xw->width, xw->height);
- gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width, xw->height); //minimum size
- //gtk_window_resize( GTK_WINDOW(xw->widget_osr), xw->width, xw->height);
- gtk_window_resize( GTK_WINDOW(xw->widgetwindow_osr), xw->width, xw->height);
- gtk_window_resize( GTK_WINDOW(xw->widgetscrolledwindow_osr), xw->width, xw->height);
- gtk_scrolled_window_set_min_content_height(GTK_SCROLLED_WINDOW(xw->widgetscrolledwindow_osr ),xw->height);
- gtk_scrolled_window_set_min_content_width(GTK_SCROLLED_WINDOW(xw->widgetscrolledwindow_osr ),xw->width);
-
- //gtk_container_resize_children ( GTK_WINDOW(xw->widgetwindow_osr));
- gtk_container_resize_children (GTK_CONTAINER(xw->widgetwindow_osr));
-
- }
-
- for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); tail = XCDR (tail)) //TODO MVC refactor lazy linear search
- {
- if (XWIDGET_VIEW_P (XCAR (tail))) {
- xv = XXWIDGET_VIEW (XCAR (tail));
- if(XXWIDGET (xv->model) == xw) {
- gtk_layout_set_size (GTK_LAYOUT (xv->widgetwindow), xw->width, xw->height);
- gtk_widget_set_size_request (GTK_WIDGET (xv->widget), xw->width, xw->height);
- }
- }
- }
-
- return Qnil;
-}
-
-
-
-DEFUN ("xwidget-set-adjustment", Fxwidget_set_adjustment, Sxwidget_set_adjustment, 4, 4, 0, doc:
- /* set scrolling */)
- (Lisp_Object xwidget, Lisp_Object axis, Lisp_Object relative, Lisp_Object value)
-{
- CHECK_XWIDGET (xwidget);
- struct xwidget* xw = XXWIDGET(xwidget);
- GtkAdjustment* adjustment;
- float final_value=0.0;
-
- if(EQ(Qvertical, axis)){
- adjustment = gtk_scrolled_window_get_vadjustment(GTK_SCROLLED_WINDOW(xw->widgetscrolledwindow_osr));
- }
- if(EQ(Qhorizontal, axis)){
- adjustment = gtk_scrolled_window_get_hadjustment(GTK_SCROLLED_WINDOW(xw->widgetscrolledwindow_osr));
- }
-
- if(EQ(Qt, relative)){
- final_value=gtk_adjustment_get_value(adjustment)+XFASTINT(value);
- }else{
- final_value=0.0+XFASTINT(value);
- }
-
- gtk_adjustment_set_value(adjustment, final_value);
-
- return Qnil;
-}
-
-
-DEFUN ("xwidget-size-request", Fxwidget_size_request, Sxwidget_size_request, 1, 1, 0, doc:
- /* Desired size of the XWIDGET.
-
- This can be used to read the xwidget desired size, and resizes the Emacs allocated area accordingly.
-
-(TODO crashes if arg not osr widget)*/)
- (Lisp_Object xwidget)
-{
- CHECK_XWIDGET (xwidget);
- GtkRequisition requisition;
- Lisp_Object rv;
- gtk_widget_size_request(XXWIDGET(xwidget)->widget_osr, &requisition);
- rv = Qnil;
- rv = Fcons (make_number(requisition.height), rv);
- rv = Fcons (make_number(requisition.width), rv);
- return rv;
-
-}
-
-DEFUN ("xwidgetp", Fxwidgetp, Sxwidgetp, 1, 1, 0,
- doc: /* Return t if OBJECT is a xwidget. */)
- (Lisp_Object object)
-{
- return XWIDGETP (object) ? Qt : Qnil;
-}
-
-DEFUN ("xwidget-view-p", Fxwidget_view_p, Sxwidget_view_p, 1, 1, 0,
- doc: /* Return t if OBJECT is a xwidget-view. */)
- (Lisp_Object object)
-{
- return XWIDGET_VIEW_P (object) ? Qt : Qnil;
-}
-
-DEFUN ("xwidget-info", Fxwidget_info , Sxwidget_info, 1,1,0,
- doc: /* Get XWIDGET properties.
- Currently type, title, width, height.*/)
- (Lisp_Object xwidget)
-{
- CHECK_XWIDGET (xwidget);
- Lisp_Object info, n;
- struct xwidget* xw = XXWIDGET(xwidget);
-
- info = Fmake_vector (make_number (4), Qnil);
- ASET (info, 0, xw->type);
- ASET (info, 1, xw->title);
- XSETFASTINT(n, xw->width);
- ASET (info, 2, n);
- XSETFASTINT(n, xw->height);
- ASET (info, 3, n);
-
- return info;
-}
-
-DEFUN ("xwidget-view-info", Fxwidget_view_info , Sxwidget_view_info, 1, 1, 0, doc:
- /* Get XWIDGET-VIEW properties.
- Currently x,y clip right, clip bottom, clip top, clip left*/)
- (Lisp_Object xwidget_view)
-{
- CHECK_XWIDGET_VIEW (xwidget_view);
- struct xwidget_view *xv = XXWIDGET_VIEW (xwidget_view);
- Lisp_Object info;
-
- info = Fmake_vector (make_number (6), Qnil);
- ASET (info, 0, make_number(xv->x));
- ASET (info, 1, make_number(xv->y));
- ASET (info, 2, make_number(xv->clip_right));
- ASET (info, 3, make_number(xv->clip_bottom));
- ASET (info, 4, make_number(xv->clip_top));
- ASET (info, 5, make_number(xv->clip_left));
-
- return info;
-}
-
-DEFUN ("xwidget-view-model", Fxwidget_view_model, Sxwidget_view_model,
- 1, 1, 0,
- doc: /* Get XWIDGET-VIEW model. */)
- (Lisp_Object xwidget_view)
-{
- CHECK_XWIDGET_VIEW (xwidget_view);
- return XXWIDGET_VIEW (xwidget_view)->model;
-}
-
-DEFUN ("xwidget-view-window", Fxwidget_view_window, Sxwidget_view_window,
- 1, 1, 0,
- doc: /* Get XWIDGET-VIEW window. */)
- (Lisp_Object xwidget_view)
-{
- CHECK_XWIDGET_VIEW (xwidget_view);
- return XXWIDGET_VIEW (xwidget_view)->w;
-}
-
-DEFUN ("xwidget-send-keyboard-event", Fxwidget_send_keyboard_event, Sxwidget_send_keyboard_event, 2, 2, 0,
- doc:/* Synthesize a kbd event for XWIDGET. TODO crashes atm.. */
- )
- (Lisp_Object xwidget, Lisp_Object keydescriptor)
-{
- //TODO this code crashes for offscreen widgets and ive tried many different strategies
- //int keyval = 0x058; //X
- int keyval = XFASTINT(keydescriptor); //X
- char *keystring = "";
- GdkKeymapKey* keys;
- gint n_keys;
- GdkDeviceManager* manager;
- struct xwidget *xw;
- GtkWidget* widget;
- GdkEventKey* ev;
- Lisp_Object window;
- //popup_activated_flag = 1; //TODO just a hack
- gdk_keymap_get_entries_for_keyval(gdk_keymap_get_default(), keyval, &keys, &n_keys);
-
- xw = XXWIDGET(xwidget);
-
- ev = (GdkEventKey*)gdk_event_new(GDK_KEY_PRESS);
-
-
- //todo what about windowless widgets?
-
- window = FRAME_SELECTED_WINDOW (SELECTED_FRAME ());
-
-
- //TODO maybe we also need to special case sockets by picking up the plug rather than the socket
- if(xw->widget_osr)
- widget = xw->widget_osr;
- else
- widget = xwidget_view_lookup(xw, XWINDOW(window))->widget;
-
- ev->window = gtk_widget_get_window(widget);
- gtk_widget_grab_focus(widget);
- ev->send_event = FALSE;
-
- ev->hardware_keycode = keys[0].keycode;
- ev->group = keys[0].group;
-
- ev->keyval = keyval;
- ev->time = GDK_CURRENT_TIME;
-
- //ev->device = gdk_device_get_core_pointer();
- manager = gdk_display_get_device_manager(gdk_window_get_display(ev->window));
- gdk_event_set_device ((GdkEvent*)ev, gdk_device_manager_get_client_pointer(manager));
- gdk_event_put((GdkEvent*)ev);
- //g_signal_emit_by_name(ev->window,"key-press-event", ev);
-
- ev->type = GDK_KEY_RELEASE;
- gdk_event_put((GdkEvent*)ev);
- //g_signal_emit_by_name(ev->window,"key-release-event", ev);
- //gtk_main_do_event(ev);
-
- //TODO
- //if I delete the event the receiving component eventually crashes.
- //it ough TDTRT since event_put is supposed to copy the event
- //so probably this leaks events now
- //gdk_event_free((GdkEvent*)ev);
-
- return Qnil;
-}
-
-DEFUN ("delete-xwidget-view", Fdelete_xwidget_view, Sdelete_xwidget_view,
- 1, 1, 0,
- doc: /* Delete the XWIDGET-VIEW. */)
- (Lisp_Object xwidget_view)
-{
- CHECK_XWIDGET_VIEW (xwidget_view);
- struct xwidget_view *xv = XXWIDGET_VIEW (xwidget_view);
- gtk_widget_destroy(xv->widgetwindow);
- Vxwidget_view_list = Fdelq (xwidget_view, Vxwidget_view_list);
-}
-
-DEFUN ("xwidget-view-lookup", Fxwidget_view_lookup, Sxwidget_view_lookup,
- 1, 2, 0,
- doc: /* Return the xwidget-view associated to XWIDGET in
-WINDOW if specified, otherwise it uses the selected window. */)
- (Lisp_Object xwidget, Lisp_Object window)
-{
- CHECK_XWIDGET (xwidget);
-
- if (NILP (window))
- window = Fselected_window();
- CHECK_WINDOW (window);
-
- for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); tail = XCDR (tail))
- {
- Lisp_Object xwidget_view = XCAR (tail);
- if (EQ (Fxwidget_view_model (xwidget_view), xwidget)
- && EQ (Fxwidget_view_window (xwidget_view), window))
- return xwidget_view;
- }
-
- return Qnil;
-}
-
-DEFUN ("set-frame-visible", Fset_frame_visible, Sset_frame_visible,
- 2, 2, 0,
- doc: /* HACKY */)
- (Lisp_Object frame, Lisp_Object flag)
-{
- CHECK_FRAME (frame);
- struct frame *f = XFRAME (frame);
- SET_FRAME_VISIBLE (f, !NILP (flag));
- return flag;
-}
-
-DEFUN ("xwidget-plist", Fxwidget_plist, Sxwidget_plist,
- 1, 1, 0,
- doc: /* Return the plist of XWIDGET. */)
- (register Lisp_Object xwidget)
-{
- CHECK_XWIDGET (xwidget);
- return XXWIDGET (xwidget)->plist;
-}
-
-DEFUN ("xwidget-buffer", Fxwidget_buffer, Sxwidget_buffer,
- 1, 1, 0,
- doc: /* Return the buffer of XWIDGET. */)
- (register Lisp_Object xwidget)
-{
- CHECK_XWIDGET (xwidget);
- return XXWIDGET (xwidget)->buffer;
-}
-
-DEFUN ("set-xwidget-plist", Fset_xwidget_plist, Sset_xwidget_plist,
- 2, 2, 0,
- doc: /* Replace the plist of XWIDGET with PLIST. Returns PLIST. */)
- (register Lisp_Object xwidget, Lisp_Object plist)
-{
- CHECK_XWIDGET (xwidget);
- CHECK_LIST (plist);
-
- XXWIDGET (xwidget)->plist = plist;
- return plist;
-}
-
-DEFUN ("set-xwidget-query-on-exit-flag",
- Fset_xwidget_query_on_exit_flag, Sset_xwidget_query_on_exit_flag,
- 2, 2, 0,
- doc: /* Specify if query is needed for XWIDGET when Emacs is
-exited. If the second argument FLAG is non-nil, Emacs will query the
-user before exiting or killing a buffer if XWIDGET is running. This
-function returns FLAG. */)
- (Lisp_Object xwidget, Lisp_Object flag)
-{
- CHECK_XWIDGET (xwidget);
- XXWIDGET (xwidget)->kill_without_query = NILP (flag);
- return flag;
-}
-
-DEFUN ("xwidget-query-on-exit-flag",
- Fxwidget_query_on_exit_flag, Sxwidget_query_on_exit_flag,
- 1, 1, 0,
- doc: /* Return the current value of query-on-exit flag for XWIDGET. */)
- (Lisp_Object xwidget)
-{
- CHECK_XWIDGET (xwidget);
- return (XXWIDGET (xwidget)->kill_without_query ? Qnil : Qt);
-}
-
-void
-syms_of_xwidget (void)
-{
- int i;
-
- defsubr (&Smake_xwidget);
- defsubr (&Sxwidgetp);
- DEFSYM (Qxwidgetp, "xwidgetp");
- defsubr (&Sxwidget_view_p);
- DEFSYM (Qxwidget_view_p, "xwidget-view-p");
- defsubr (&Sxwidget_info);
- defsubr (&Sxwidget_view_info);
- defsubr (&Sxwidget_resize);
- defsubr (&Sget_buffer_xwidgets);
- defsubr (&Sxwidget_view_model);
- defsubr (&Sxwidget_view_window);
- defsubr (&Sxwidget_view_lookup);
- defsubr (&Sxwidget_query_on_exit_flag);
- defsubr (&Sset_xwidget_query_on_exit_flag);
- defsubr (&Sset_frame_visible);
-
- #ifdef HAVE_WEBKIT_OSR
- defsubr (&Sxwidget_webkit_goto_uri);
- defsubr (&Sxwidget_webkit_execute_script);
- defsubr (&Sxwidget_webkit_get_title);
- DEFSYM (Qwebkit_osr, "webkit-osr");
- #endif
-
- defsubr (&Sxwgir_xwidget_call_method );
- defsubr (&Sxwgir_require_namespace);
- defsubr (&Sxwidget_size_request );
- defsubr (&Sdelete_xwidget_view);
- defsubr (&Sxwidget_disable_plugin_for_mime);
-
- defsubr (&Sxwidget_send_keyboard_event);
- defsubr (&Sxwidget_webkit_dom_dump);
- defsubr (&Sxwidget_plist);
- defsubr (&Sxwidget_buffer);
- defsubr (&Sset_xwidget_plist);
-
- defsubr (&Sxwidget_set_adjustment);
-
- DEFSYM (Qxwidget, "xwidget");
-
- DEFSYM (QCxwidget, ":xwidget");
- DEFSYM (QCxwgir_class, ":xwgir-class");
- DEFSYM (QCtitle, ":title");
-
- /* Do not forget to update the docstring of make-xwidget if you add
- new types. */
- DEFSYM (Qbutton, "Button"); //changed to match the gtk class because xwgir(experimental and not really needed)
- DEFSYM (Qtoggle, "ToggleButton");
- DEFSYM (Qslider, "slider");
- DEFSYM (Qsocket, "socket");
- DEFSYM (Qsocket_osr, "socket-osr");
- DEFSYM (Qcairo, "cairo");
-
- DEFSYM (Qvertical, "vertical");
- DEFSYM (Qhorizontal, "horizontal");
-
- DEFSYM (QCplist, ":plist");
-
- DEFVAR_LISP ("xwidget-list", Vxwidget_list, doc: /*xwidgets list*/);
- Vxwidget_list = Qnil;
-
- DEFVAR_LISP ("xwidget-view-list", Vxwidget_view_list, doc: /*xwidget views list*/);
- Vxwidget_view_list = Qnil;
-
- Fprovide (intern ("xwidget-internal"), Qnil);
-
-}
-
-
-/* Value is non-zero if OBJECT is a valid Lisp xwidget specification. A
- valid xwidget specification is a list whose car is the symbol
- `xwidget', 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 xwidget type. The rest of the property list depends on the
- xwidget type. */
-
-int
-valid_xwidget_spec_p (Lisp_Object object)
-{
- int valid_p = 0;
-
- if (CONSP (object) && EQ (XCAR (object), Qxwidget))
- {
- /* Lisp_Object tem; */
-
- /* for (tem = XCDR (object); CONSP (tem); tem = XCDR (tem)) */
- /* if (EQ (XCAR (tem), QCtype)) */
- /* { */
- /* tem = XCDR (tem); */
- /* if (CONSP (tem) && SYMBOLP (XCAR (tem))) */
- /* { */
- /* struct xwidget_type *type; */
- /* type = lookup_xwidget_type (XCAR (tem)); */
- /* if (type) */
- /* valid_p = type->valid_p (object); */
- /* } */
-
- /* break; */
- /* } */
- //never mind type support for now
- valid_p = 1;
- }
-
- return valid_p;
-}
-
-
-
-/* find a value associated with key in spec */
-Lisp_Object
-xwidget_spec_value ( Lisp_Object spec, Lisp_Object key,
- int *found)
-{
- Lisp_Object tail;
-
- eassert (valid_xwidget_spec_p (spec));
-
- for (tail = XCDR (spec);
- CONSP (tail) && CONSP (XCDR (tail)); tail = XCDR (XCDR (tail)))
- {
- if (EQ (XCAR (tail), key))
- {
- if (found)
- *found = 1;
- return XCAR (XCDR (tail));
- }
- }
-
- if (found)
- *found = 0;
- return Qnil;
-}
-
-
-void
-xwidget_view_delete_all_in_window (struct window *w)
-{
- struct xwidget_view* xv = NULL;
- for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); tail = XCDR (tail))
- {
- if (XWIDGET_VIEW_P (XCAR (tail))) {
- xv = XXWIDGET_VIEW (XCAR (tail));
- if(XWINDOW (xv->w) == w) {
- gtk_widget_destroy(xv->widgetwindow);
- Vxwidget_view_list = Fdelq (XCAR (tail), Vxwidget_view_list);
- }
- }
- }
-}
-
-struct xwidget_view*
-xwidget_view_lookup (struct xwidget* xw, struct window *w)
-{
- Lisp_Object xwidget, window, ret;
- XSETXWIDGET (xwidget, xw);
- XSETWINDOW (window, w);
-
- ret = Fxwidget_view_lookup (xwidget, window);
-
- return EQ (ret, Qnil) ? NULL : XXWIDGET_VIEW (ret);
-}
-
-struct xwidget*
-lookup_xwidget (Lisp_Object spec)
-{
- /* When a xwidget lisp spec is found initialize the C struct that is used in the C code.
- This is done by redisplay so values change if the spec changes.
- So, take special care of one-shot events
-
- TODO remove xwidget init from display spec. simply store an xwidget reference only and set
- size etc when creating the xwidget, which should happen before insertion into buffer
- */
- int found = 0, found1 = 0, found2 = 0;
- Lisp_Object value;
- struct xwidget *xw;
-
- value = xwidget_spec_value (spec, QCxwidget, &found1);
- xw = XXWIDGET(value);
-
- return xw;
-}
-
-/*set up detection of touched xwidget*/
-void
-xwidget_start_redisplay (void)
-{
- for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); tail = XCDR (tail))
- {
- if (XWIDGET_VIEW_P (XCAR (tail)))
- XXWIDGET_VIEW (XCAR (tail))->redisplayed = 0;
- }
-}
-
-/* the xwidget was touched during redisplay, so it isnt a candidate for hiding*/
-void
-xwidget_touch (struct xwidget_view *xv)
-{
- xv->redisplayed = 1;
-}
-
-int
-xwidget_touched (struct xwidget_view *xv)
-{
- return xv->redisplayed;
-}
-
-/* redisplay has ended, now we should hide untouched xwidgets
-*/
-void
-xwidget_end_redisplay (struct window *w, struct glyph_matrix *matrix)
-{
-
- int i;
- struct xwidget *xw;
- int area;
-
-
- xwidget_start_redisplay ();
- //iterate desired glyph matrix of window here, hide gtk widgets
- //not in the desired matrix.
-
- //this only takes care of xwidgets in active windows.
- //if a window goes away from screen xwidget views wust be deleted
-
- // dump_glyph_matrix(matrix, 2);
- for (i = 0; i < matrix->nrows; ++i)
- {
- // dump_glyph_row (MATRIX_ROW (matrix, i), i, glyphs);
- struct glyph_row *row;
- row = MATRIX_ROW (matrix, i);
- if (row->enabled_p != 0)
- {
- for (area = LEFT_MARGIN_AREA; area < LAST_AREA; ++area)
- {
- struct glyph *glyph = row->glyphs[area];
- struct glyph *glyph_end = glyph + row->used[area];
- for (; glyph < glyph_end; ++glyph)
- {
- if (glyph->type == XWIDGET_GLYPH)
- {
- /*
- the only call to xwidget_end_redisplay is in dispnew
- xwidget_end_redisplay(w->current_matrix);
- */
- xwidget_touch (xwidget_view_lookup(glyph->u.xwidget,
- w));
- }
- }
- }
- }
- }
-
- for (Lisp_Object tail = Vxwidget_view_list; CONSP (tail); tail = XCDR (tail))
- {
- if (XWIDGET_VIEW_P (XCAR (tail))) {
- struct xwidget_view* xv = XXWIDGET_VIEW (XCAR (tail));
-
- //"touched" is only meaningful for the current window, so disregard other views
- if (XWINDOW (xv->w) == w) {
- if (xwidget_touched(xv))
- xwidget_show_view (xv);
- else
- xwidget_hide_view (xv);
- }
- }
- }
-}
-
-/* Kill all xwidget in BUFFER. */
-void
-kill_buffer_xwidgets (Lisp_Object buffer)
-{
- Lisp_Object tail, xwidget;
- for (tail = Fget_buffer_xwidgets (buffer); CONSP (tail); tail = XCDR (tail))
- {
- xwidget = XCAR (tail);
- Vxwidget_list = Fdelq (xwidget, Vxwidget_list);
- /* TODO free the GTK things in xw */
- {
- CHECK_XWIDGET (xwidget);
- struct xwidget *xw = XXWIDGET (xwidget);
- if (xw->widget_osr && xw->widgetwindow_osr)
- {
- gtk_widget_destroy(xw->widget_osr);
- gtk_widget_destroy(xw->widgetwindow_osr);
- }
- }
- }
-}
-
-#endif /* HAVE_XWIDGETS */
+++ /dev/null
-#ifndef XWIDGET_H_INCLUDED
-#define XWIDGET_H_INCLUDED
-
-void x_draw_xwidget_glyph_string (struct glyph_string *s);
-void syms_of_xwidget ();
-
-//extern Lisp_Object Qxwidget;
-
-
-int valid_xwidget_spec_p (Lisp_Object object) ;
-
-#include <gtk/gtk.h>
-
-
-/*
-each xwidget instance/model is described by this struct.
-
-lisp pseudovector.
-
-
- */
-struct xwidget{
- struct vectorlike_header header;
- Lisp_Object plist;//auxilliary data
- Lisp_Object type;//the widget type
- Lisp_Object buffer; //buffer where xwidget lives
- Lisp_Object title;//a title that is used for button labels for instance
-
- //here ends the lisp part.
- //"height" is the marker field
- int height;
- int width;
-
- //for offscreen widgets, unused if not osr
- GtkWidget* widget_osr;
- GtkWidget* widgetwindow_osr;
- //this is used if the widget (webkit) is to be wrapped in a scrolled window,
- GtkWidget* widgetscrolledwindow_osr;
- /* Non-nil means kill silently if Emacs is exited. */
- unsigned int kill_without_query : 1;
-
-};
-
-
-//struct for each xwidget view
-struct xwidget_view {
- struct vectorlike_header header;
- Lisp_Object model;
- Lisp_Object w;
-
- //here ends the lisp part.
- //"redisplayed" is the marker field
- int redisplayed; //if touched by redisplay
-
- int hidden;//if the "live" instance isnt drawn
-
- GtkWidget* widget;
- GtkWidget* widgetwindow;
- GtkWidget* emacswindow;
- int x; int y;
- int clip_right; int clip_bottom; int clip_top; int clip_left;
-
-
- long handler_id;
-};
-
-/* Test for xwidget pseudovector*/
-#define XWIDGETP(x) PSEUDOVECTORP (x, PVEC_XWIDGET)
-#define XXWIDGET(a) (eassert (XWIDGETP(a)), \
- (struct xwidget *) XUNTAG(a, Lisp_Vectorlike))
-
-#define CHECK_XWIDGET(x) \
- CHECK_TYPE (XWIDGETP (x), Qxwidgetp, x)
-
-/* Test for xwidget_view pseudovector */
-#define XWIDGET_VIEW_P(x) PSEUDOVECTORP (x, PVEC_XWIDGET_VIEW)
-#define XXWIDGET_VIEW(a) (eassert (XWIDGET_VIEW_P(a)), \
- (struct xwidget_view *) XUNTAG(a, Lisp_Vectorlike))
-
-#define CHECK_XWIDGET_VIEW(x) \
- CHECK_TYPE (XWIDGET_VIEW_P (x), Qxwidget_view_p, x)
-
-struct xwidget_type
-{
- /* A symbol uniquely identifying the xwidget type, */
- 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);
-
- /* Next in list of all supported image types. */
- struct xwidget_type *next;
-};
-
-static struct xwidget_type *lookup_xwidget_type (Lisp_Object symbol);
-
-struct xwidget* xwidget_from_id(int id);
-
-//extern int xwidget_owns_kbd;
-
-void xwidget_start_redisplay();
-void xwidget_end_redisplay (struct window *w, struct glyph_matrix *matrix);
-
-void xwidget_touch (struct xwidget_view *xw);
-
-//void assert_valid_xwidget_id(int id,char *str);
-
-struct xwidget* lookup_xwidget (Lisp_Object spec);
-#define XG_XWIDGET "emacs_xwidget"
-#define XG_XWIDGET_VIEW "emacs_xwidget_view"
-void xwidget_view_delete_all_in_window( struct window *w );
-
-void kill_buffer_xwidgets (Lisp_Object buffer);
-#endif /* XWIDGET_H_INCLUDED */
-2015-02-01 Joakim Verona <joakim@verona.se>
- Support for testing xwidgets
- * xwidget-test-manual.el:
+2015-04-01 Artur Malabarba <bruce.connor.am@gmail.com>
-2015-02-01 Grégoire Jadi <daimrod@gmail.com>
- Support for testing xwidgets
- * automated/xwidget-tests.el:
+ * automated/package-test.el: Avoid async while testing.
+ (package-test-update-archives): Fix test.
+
+2015-03-27 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * automated/textprop-tests.el: New file.
+ (textprop-tests-font-lock--remove-face-from-text-property): New test.
+
+2015-03-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * automated/tramp-tests.el (tramp-test18-file-attributes)
+ (tramp--test-check-files): Extend tests.
+ (tramp-test31-utf8): Do not skip for tramp-adb.el.
+
+2015-03-24 Daiki Ueno <ueno@gnu.org>
+
+ * automated/epg-tests.el: New file.
+ * automated/data/epg/pubkey.asc: New file.
+ * automated/data/epg/seckey.asc: New file.
+
+2015-03-22 Dmitry Gutov <dgutov@yandex.ru>
+
+ * automated/json-tests.el: New file.
+
+2015-03-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * automated/eieio-tests.el (eieio-test-17-virtual-slot): Don't use
+ initarg in `oset'.
+ (eieio-test-32-slot-attribute-override-2): Adjust to new
+ slot representation.
+
+ * automated/eieio-test-persist.el (persist-test-save-and-compare):
+ Adjust to new slot representation.
+
+ * automated/eieio-test-methodinvoke.el (make-instance): Use new-style
+ `subclass' specializer for a change.
+
+2015-03-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * automated/cl-lib-tests.el: Use lexical-binding.
+ (cl-lib-arglist-performance): Refine test to the case where one of the
+ fields has a non-nil default value. Use existing `mystruct' defstruct.
+ (cl-lib-struct-accessors): Use `pcase' to be a bit more flexible in the
+ accepted outputs.
+
+2015-03-16 Ken Brown <kbrown@cornell.edu>
+
+ * automated/tramp-tests.el (tramp--test-special-characters):
+ Don't test "\t" in file names on Cygwin. (Bug#20119)
+
+2015-03-10 Jackson Ray Hamilton <jackson@jacksonrayhamilton.com>
+
+ * indent/js-indent-init-dynamic.js: Fix spelling error.
+
+2015-03-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer "initialize" to "initialise"
+ * indent/js-indent-init-t.js: Rename from
+ indent/js-indent-first-initialiser-t.js.
+ * indent/js-indent-init-dynamic.js: Rename from
+ test/indent/js-indent-first-initialiser-dynamic.js.
+
+2015-03-10 Jackson Ray Hamilton <jackson@jacksonrayhamilton.com>
+
+ * indent/js.js: Add local variables.
+
+ * indent/js-indent-first-initialiser-t.js:
+ * indent/js-indent-first-initialiser-dynamic.js:
+ New tests for `js-indent-first-initialiser'.
+
+2015-03-10 Przemyslaw Wojnowski <esperanto@cumego.com>
+
+ * automated/cl-lib-tests.el: Add tests for plusp, second, ...
+ (cl-lib-test-plusp, cl-lib-test-minusp)
+ (cl-lib-test-oddp, cl-lib-test-evenp, cl-lib-test-first)
+ (cl-lib-test-second, cl-lib-test-third, cl-lib-test-fourth)
+ (cl-lib-test-fifth, cl-lib-test-sixth, cl-lib-test-seventh)
+ (cl-lib-test-eighth, cl-lib-test-ninth, cl-lib-test-tenth)
+ (cl-lib-test-endp, cl-lib-test-nth-value)
+ (cl-lib-nth-value-test-multiple-values, cl-test-caaar, cl-test-caadr)
+ (cl-test-ldiff): New tests.
+ (cl-digit-char-p): Tighten the test.
+
+2015-03-09 Dmitry Gutov <dgutov@yandex.ru>
+
+ * indent/Makefile: Call 'rm' with '-f'. Default EMACS to
+ '../../src/emacs'. Remove *.new in 'clean'. Set 'all' target to
+ run all examples.
+
+2015-03-09 Nicolas Petton <nicolas@petton.fr>
+
+ * automated/seq-tests.el (test-seq-into): Add a test for seq-into.
+
+2015-03-08 Dmitry Gutov <dgutov@yandex.ru>
+
+ * indent/ruby.rb: Add an example for bug#20026.
+
+ * indent/js.js: Set `js-indent-level' to 2. Fix indentation in an
+ example.
+
+2015-03-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * automated/tramp-tests.el (top): Declare `tramp-get-remote-stat'
+ and `tramp-get-remote-perl'.
+ (tramp-test06-directory-file-name): Fix docstring and last test.
+ (tramp-test08-file-local-copy): Extend test.
+ (tramp-test13-make-directory): Test also PARENTS arg.
+ (tramp-test17-insert-directory): Do not expect any order in
+ directory listing.
+ (tramp--test-adb-p): New defun.
+ (tramp--test-check-files): Fix doxstring. Extend tests.
+ (tramp--test-special-characters): New defun. Use body from
+ `tramp-test30-special-characters'. Adapt check for tramp-adb.el.
+ (tramp-test30-special-characters): Use it.
+ (tramp--test-utf8): New defun. Use body from
+ `tramp-test31-utf8'. Add test string.
+ (tramp-test31-utf8): Use it.
+ (tramp-test30-special-characters-with-stat)
+ (tramp-test30-special-characters-with-perl)
+ (tramp-test30-special-characters-with-ls):
+ (tramp-test31-utf8-with-stat, tramp-test31-utf8-with-perl)
+ (tramp-test31-utf8-with-ls): New tests.
+
+2015-03-03 Daniel Colascione <dancol@dancol.org>
+
+ * automated/generator-tests.el (cps-testcase):
+ Use `cps-inhibit-atomic-optimization' instead of
+ `cps-disable-atomic-optimization'.
+ (cps-test-declarations-preserved): New test.
+
+ * automated/finalizer-tests.el (finalizer-basic)
+ (finalizer-circular-reference, finalizer-cross-reference)
+ (finalizer-error): Rename `gc-precise-p' to `gc-precise'.
+
+ * automated/generator-tests.el (cps-test-iter-close-finalizer):
+ Rename `gc-precise-p' to `gc-precise'.
+
+2015-03-03 Glenn Morris <rgm@gnu.org>
+
+ * automated/generator-tests.el (cps-while-incf)
+ (cps-test-iter-cleanup-once-only): Replace undefined incf with cl-incf.
+ (cps-test-iter-do): Use should not undefined assert.
+
+2015-03-03 Daniel Colascione <dancol@dancol.org>
+
+ * automated/finalizer-tests.el (finalizer-object-type): Test that
+ `type-of' works correctly for finalizers.
+
+2015-03-02 Daniel Colascione <dancol@dancol.org>
+
+ * automated/generator-tests.el: New tests
+
+ * automated/finalizer-tests.el (finalizer-basic)
+ (finalizer-circular-reference, finalizer-cross-reference)
+ (finalizer-error): New tests.
+
+2015-03-01 Michael Albinus <michael.albinus@gmx.de>
+
+ * automated/vc-tests.el (vc-test--create-repo): Add check for
+ `vc-responsible-backend'.
+ (vc-test--register): Do not print a message when unsupported.
+ (vc-test--state, vc-test--working-revision): Rework. Raise no
+ error in case of inconsistent result, but document everything.
+ (vc-test--checkout-model): New defun.
+ (vc-test-*-checkout-model): New tests.
+
+2015-02-26 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * automated/python-tests.el
+ (python-indent-dedent-line-backspace-2)
+ (python-indent-dedent-line-backspace-3): New tests.
+
+2015-02-26 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * automated/python-tests.el (python-indent-pep8-1)
+ (python-indent-pep8-2, python-indent-pep8-3)
+ (python-indent-after-comment-2): Fix tests.
+ (python-indent-after-comment-3): New test.
+
+2015-02-24 Glenn Morris <rgm@gnu.org>
+
+ * automated/f90.el (f90-test-bug-19809): New test.
+
+2015-02-22 Michael Albinus <michael.albinus@gmx.de>
+
+ * automated/tramp-tests.el (tramp-test17-insert-directory):
+ Suppress localized settings in order to have a proper check for
+ the summary line.
+
+2015-02-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * automated/eieio-test-methodinvoke.el (make-instance): Add methods
+ here rather than on eieio-constructor.
+
+2015-02-13 Magnus Henoch <magnus.henoch@gmail.com>
+
+ * automated/sasl-scram-rfc-tests.el: New file.
+
+2015-02-11 Nicolas Petton <nicolas@petton.fr>
+
+ * automated/seq-tests.el (test-seq-reverse, test-seq-group-by):
+ Add a test for seq-reverse and update test for seq-group-by to
+ test vectors and strings, not only lists.
+
+2015-02-10 Glenn Morris <rgm@gnu.org>
+
+ * automated/package-test.el (package-test-signed):
+ More informative failure messages.
+
+2015-02-09 Nicolas Petton <nicolas@petton.fr>
+
+ * automated/seq-tests.el (test-seq-group-by): Update test for
+ seq-group-by to check that sequence elements are returned in the
+ correct order.
+
+2015-02-07 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * automated/python-tests.el (python-eldoc--get-symbol-at-point-1)
+ (python-eldoc--get-symbol-at-point-2)
+ (python-eldoc--get-symbol-at-point-3)
+ (python-eldoc--get-symbol-at-point-4): New tests.
+
+ * automated/python-tests.el (python-tests-visible-string):
+ New function.
+ (python-parens-electric-indent-1)
+ (python-triple-quote-pairing): Fix indentation, move require calls.
+ (python-hideshow-hide-levels-1)
+ (python-hideshow-hide-levels-2): New tests.
+
+2015-02-07 Dmitry Gutov <dgutov@yandex.ru>
+
+ * automated/vc-tests.el (vc-test--working-revision):
+ Fix `vc-working-revision' checks to be compared against nil, which is
+ what is should return for unregistered files.
+
+2015-02-06 Nicolas Petton <nicolas@petton.fr>
+
+ * automated/seq-tests.el: New tests for seq-mapcat, seq-partition
+ and seq-group-by.
+
+2015-02-05 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * automated/package-test.el (package-test-get-deps): Fix typo.
+ (package-test-sort-by-dependence): New test
+
+2015-02-03 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * automated/package-test.el (package-test-get-deps): New test.
2015-01-31 Stefan Monnier <monnier@iro.umontreal.ca>
-;;; cl-lib.el --- tests for emacs-lisp/cl-lib.el
+;;; cl-lib.el --- tests for emacs-lisp/cl-lib.el -*- lexical-binding:t -*-
;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
:b :a :a 42)
'(42 :a))))
-(cl-defstruct mystruct (abc :readonly t) def)
+(cl-defstruct (mystruct
+ (:constructor cl-lib--con-1 (&aux (abc 1)))
+ (:constructor cl-lib--con-2 (&optional def)))
+ (abc 5 :readonly t) (def nil))
(ert-deftest cl-lib-struct-accessors ()
(let ((x (make-mystruct :abc 1 :def 2)))
(should (eql (cl-struct-slot-value 'mystruct 'abc x) 1))
(should (eql (cl-struct-slot-value 'mystruct 'def x) -1))
(should (eql (cl-struct-slot-offset 'mystruct 'abc) 1))
(should-error (cl-struct-slot-offset 'mystruct 'marypoppins))
- (should (equal (cl-struct-slot-info 'mystruct)
- '((cl-tag-slot) (abc :readonly t) (def))))))
+ (should (pcase (cl-struct-slot-info 'mystruct)
+ (`((cl-tag-slot) (abc 5 :readonly t)
+ (def . ,(or `nil `(nil))))
+ t)))))
+
+(ert-deftest cl-lib-arglist-performance ()
+ ;; An `&aux' should not cause lambda's arglist to be turned into an &rest
+ ;; that's parsed by hand.
+ (should (equal () (help-function-arglist 'cl-lib--con-1)))
+ (should (pcase (help-function-arglist 'cl-lib--con-2)
+ (`(&optional ,_) t))))
(ert-deftest cl-the ()
(should (eql (cl-the integer 42) 42))
(should (= (cl-the integer (cl-incf side-effect)) 1))
(should (= side-effect 1))))
+(ert-deftest cl-lib-test-plusp ()
+ (should-not (cl-plusp -1.0e+INF))
+ (should-not (cl-plusp -1.5e2))
+ (should-not (cl-plusp -3.14))
+ (should-not (cl-plusp -1))
+ (should-not (cl-plusp -0.0))
+ (should-not (cl-plusp 0))
+ (should-not (cl-plusp 0.0))
+ (should-not (cl-plusp -0.0e+NaN))
+ (should-not (cl-plusp 0.0e+NaN))
+ (should (cl-plusp 1))
+ (should (cl-plusp 3.14))
+ (should (cl-plusp 1.5e2))
+ (should (cl-plusp 1.0e+INF))
+ (should-error (cl-plusp "42") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-minusp ()
+ (should (cl-minusp -1.0e+INF))
+ (should (cl-minusp -1.5e2))
+ (should (cl-minusp -3.14))
+ (should (cl-minusp -1))
+ (should-not (cl-minusp -0.0))
+ (should-not (cl-minusp 0))
+ (should-not (cl-minusp 0.0))
+ (should-not (cl-minusp -0.0e+NaN))
+ (should-not (cl-minusp 0.0e+NaN))
+ (should-not (cl-minusp 1))
+ (should-not (cl-minusp 3.14))
+ (should-not (cl-minusp 1.5e2))
+ (should-not (cl-minusp 1.0e+INF))
+ (should-error (cl-minusp "-42") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-oddp ()
+ (should (cl-oddp -3))
+ (should (cl-oddp 3))
+ (should-not (cl-oddp -2))
+ (should-not (cl-oddp 0))
+ (should-not (cl-oddp 2))
+ (should-error (cl-oddp 3.0e+NaN) :type 'wrong-type-argument)
+ (should-error (cl-oddp 3.0) :type 'wrong-type-argument)
+ (should-error (cl-oddp "3") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-evenp ()
+ (should (cl-evenp -2))
+ (should (cl-evenp 0))
+ (should (cl-evenp 2))
+ (should-not (cl-evenp -3))
+ (should-not (cl-evenp 3))
+ (should-error (cl-evenp 2.0e+NaN) :type 'wrong-type-argument)
+ (should-error (cl-evenp 2.0) :type 'wrong-type-argument)
+ (should-error (cl-evenp "2") :type 'wrong-type-argument))
+
(ert-deftest cl-digit-char-p ()
- (should (cl-digit-char-p ?3))
- (should (cl-digit-char-p ?a 11))
+ (should (eql 3 (cl-digit-char-p ?3)))
+ (should (eql 10 (cl-digit-char-p ?a 11)))
+ (should (eql 10 (cl-digit-char-p ?A 11)))
(should-not (cl-digit-char-p ?a))
- (should (cl-digit-char-p ?w 36))
- (should-error (cl-digit-char-p ?a 37))
- (should-error (cl-digit-char-p ?a 1)))
+ (should (eql 32 (cl-digit-char-p ?w 36)))
+ (should-error (cl-digit-char-p ?a 37) :type 'args-out-of-range)
+ (should-error (cl-digit-char-p ?a 1) :type 'args-out-of-range))
+
+(ert-deftest cl-lib-test-first ()
+ (should (null (cl-first '())))
+ (should (= 4 (cl-first '(4))))
+ (should (= 4 (cl-first '(4 2))))
+ (should-error (cl-first "42") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-second ()
+ (should (null (cl-second '())))
+ (should (null (cl-second '(4))))
+ (should (= 2 (cl-second '(1 2))))
+ (should (= 2 (cl-second '(1 2 3))))
+ (should-error (cl-second "1 2 3") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-third ()
+ (should (null (cl-third '())))
+ (should (null (cl-third '(1 2))))
+ (should (= 3 (cl-third '(1 2 3))))
+ (should (= 3 (cl-third '(1 2 3 4))))
+ (should-error (cl-third "123") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-fourth ()
+ (should (null (cl-fourth '())))
+ (should (null (cl-fourth '(1 2 3))))
+ (should (= 4 (cl-fourth '(1 2 3 4))))
+ (should (= 4 (cl-fourth '(1 2 3 4 5))))
+ (should-error (cl-fourth "1234") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-fifth ()
+ (should (null (cl-fifth '())))
+ (should (null (cl-fifth '(1 2 3 4))))
+ (should (= 5 (cl-fifth '(1 2 3 4 5))))
+ (should (= 5 (cl-fifth '(1 2 3 4 5 6))))
+ (should-error (cl-fifth "12345") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-fifth ()
+ (should (null (cl-fifth '())))
+ (should (null (cl-fifth '(1 2 3 4))))
+ (should (= 5 (cl-fifth '(1 2 3 4 5))))
+ (should (= 5 (cl-fifth '(1 2 3 4 5 6))))
+ (should-error (cl-fifth "12345") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-sixth ()
+ (should (null (cl-sixth '())))
+ (should (null (cl-sixth '(1 2 3 4 5))))
+ (should (= 6 (cl-sixth '(1 2 3 4 5 6))))
+ (should (= 6 (cl-sixth '(1 2 3 4 5 6 7))))
+ (should-error (cl-sixth "123456") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-seventh ()
+ (should (null (cl-seventh '())))
+ (should (null (cl-seventh '(1 2 3 4 5 6))))
+ (should (= 7 (cl-seventh '(1 2 3 4 5 6 7))))
+ (should (= 7 (cl-seventh '(1 2 3 4 5 6 7 8))))
+ (should-error (cl-seventh "1234567") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-eighth ()
+ (should (null (cl-eighth '())))
+ (should (null (cl-eighth '(1 2 3 4 5 6 7))))
+ (should (= 8 (cl-eighth '(1 2 3 4 5 6 7 8))))
+ (should (= 8 (cl-eighth '(1 2 3 4 5 6 7 8 9))))
+ (should-error (cl-eighth "12345678") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-ninth ()
+ (should (null (cl-ninth '())))
+ (should (null (cl-ninth '(1 2 3 4 5 6 7 8))))
+ (should (= 9 (cl-ninth '(1 2 3 4 5 6 7 8 9))))
+ (should (= 9 (cl-ninth '(1 2 3 4 5 6 7 8 9 10))))
+ (should-error (cl-ninth "123456789") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-tenth ()
+ (should (null (cl-tenth '())))
+ (should (null (cl-tenth '(1 2 3 4 5 6 7 8 9))))
+ (should (= 10 (cl-tenth '(1 2 3 4 5 6 7 8 9 10))))
+ (should (= 10 (cl-tenth '(1 2 3 4 5 6 7 8 9 10 11))))
+ (should-error (cl-tenth "1234567890") :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-endp ()
+ (should (cl-endp '()))
+ (should-not (cl-endp '(1)))
+ (should-error (cl-endp 1) :type 'wrong-type-argument)
+ (should-error (cl-endp [1]) :type 'wrong-type-argument))
+
+(ert-deftest cl-lib-test-nth-value ()
+ (let ((vals (cl-values 2 3)))
+ (should (= (cl-nth-value 0 vals) 2))
+ (should (= (cl-nth-value 1 vals) 3))
+ (should (null (cl-nth-value 2 vals)))
+ (should-error (cl-nth-value 0.0 vals) :type 'wrong-type-argument)))
+
+(ert-deftest cl-lib-nth-value-test-multiple-values ()
+ "While CL multiple values are an alias to list, these won't work."
+ :expected-result :failed
+ (should (eq (cl-nth-value 0 '(2 3)) '(2 3)))
+ (should (= (cl-nth-value 0 1) 1))
+ (should (null (cl-nth-value 1 1)))
+ (should-error (cl-nth-value -1 (cl-values 2 3)) :type 'args-out-of-range)
+ (should (string= (cl-nth-value 0 "only lists") "only lists")))
+
+(ert-deftest cl-test-caaar ()
+ (should (null (cl-caaar '())))
+ (should (null (cl-caaar '(() (2)))))
+ (should (null (cl-caaar '((() (2)) (a b)))))
+ (should-error (cl-caaar '(1 2)) :type 'wrong-type-argument)
+ (should-error (cl-caaar '((1 2))) :type 'wrong-type-argument)
+ (should (= 1 (cl-caaar '(((1 2) (3 4))))))
+ (should (null (cl-caaar '((() (3 4)))))))
+
+(ert-deftest cl-test-caadr ()
+ (should (null (cl-caadr '())))
+ (should (null (cl-caadr '(1))))
+ (should-error (cl-caadr '(1 2)) :type 'wrong-type-argument)
+ (should (= 2 (cl-caadr '(1 (2 3)))))
+ (should (equal '((2) (3)) (cl-caadr '((1) (((2) (3))) (4))))))
+
+(ert-deftest cl-test-ldiff ()
+ (let ((l '(1 2 3)))
+ (should (null (cl-ldiff '() '())))
+ (should (null (cl-ldiff '() l)))
+ (should (null (cl-ldiff l l)))
+ (should (equal l (cl-ldiff l '())))
+ ;; must be part of the list
+ (should (equal l (cl-ldiff l '(2 3))))
+ (should (equal '(1) (cl-ldiff l (nthcdr 1 l))))
+ ;; should return a copy
+ (should-not (eq (cl-ldiff l '()) l))))
(ert-deftest cl-parse-integer ()
(should-error (cl-parse-integer "abc"))
(ert-deftest cl-flet-test ()
(should (equal (cl-flet ((f1 (x) x)) (let ((x #'f1)) (funcall x 5))) 5)))
+(ert-deftest cl-lib-test-typep ()
+ (cl-deftype cl-lib-test-type (&optional x) `(member ,x))
+ ;; Make sure we correctly implement the rule that deftype's optional args
+ ;; default to `*' rather than to nil.
+ (should (cl-typep '* 'cl-lib-test-type))
+ (should-not (cl-typep 1 'cl-lib-test-type)))
+
;;; cl-lib.el ends here
--- /dev/null
+-----BEGIN PGP PUBLIC KEY BLOCK-----
+Version: GnuPG v1
+
+mI0EVRDxCAEEALcScrRmxq5N+Hh+NxPg75RJJdtEi824pwtqMlT/3wG1esmP5gNu
+ZIPVaTTSGNZkEzeYdhaLXBUe5qD+RQIQVh+MLt9nisF9nD35imyOrhHwAHnglOPx
+GdylH8nQ/tIO5p/lfUlw+iCBlPH7eZHqFJhwP0hJML4PKE8ArWG6RtsxABEBAAG0
+J0pvZSBUZXN0ZXIgKHRlc3Qga2V5KSA8am9lQGV4YW1wbGUuY29tPoi4BBMBAgAi
+BQJVEPEIAhsDBgsJCAcDAgYVCAIJCgsEFgIDAQIeAQIXgAAKCRAoscCWMvu4GGYO
+A/0Zzoc2z/dvAtFVLh4ovKqP2qliQt2qschJHVP30hJnKT7dmJfJl7kz9mXmMfSt
+Ym0luYmeSzdeWORM9SygLRYXuDfN6G4ZPJTlsRhgnARhNzNhSx+YlcFh48Z+a5zR
+goBMn7DgYVqfU4UteZOSXMlnuA2Z5ao1qgGhVqESSJgU5riNBFUQ8QgBBADacLkK
+D0U11nmlsScxPGkrDr0aJPrG8MEaDRnKjHJKNp3XTp1psGBUpWF/ErjQAIu+psFt
+LO8owCGsg/vJM7CzTv2dVBRbrZXjIKvdq7HdivosTMaHArQBpEtSO9rmgVHO+jaQ
+q/M2oGvNEB86zo3nfTWhOgBiB32m8kttWRiuWQARAQABiJ8EGAECAAkFAlUQ8QgC
+GwwACgkQKLHAljL7uBj44AQAkMJRm7VJUryrDKFtfIfytQx/vmyU/cZcVV6IpKqP
+KhztgR+QD9czlHvQhz+y3hqtLRShu2Eyf75dNexcUvKs/lS4LIDXg5V7pWSRk9eQ
+G403muqR/NGu6+QmUx09rJl72trdaGxNkyHA7Zy7ZDGkcMvQsd3qoSNGsPR5TKes
+w7Q=
+=NMxb
+-----END PGP PUBLIC KEY BLOCK-----
--- /dev/null
+-----BEGIN PGP PRIVATE KEY BLOCK-----
+Version: GnuPG v1
+
+lQHYBFUQ8QgBBAC3EnK0ZsauTfh4fjcT4O+USSXbRIvNuKcLajJU/98BtXrJj+YD
+bmSD1Wk00hjWZBM3mHYWi1wVHuag/kUCEFYfjC7fZ4rBfZw9+Ypsjq4R8AB54JTj
+8RncpR/J0P7SDuaf5X1JcPoggZTx+3mR6hSYcD9ISTC+DyhPAK1hukbbMQARAQAB
+AAP9Hs9agZTobA5QOksXjt9kwqJ63gePtbwVVNz3AoobaGi39PMkRUCPZwaEEbEo
+H/CwsUMV4J5sjVtpef/A8mN4csai7NYp82mbo+dPim4p+SUtBg4Ms8ujGVcQeRQd
+1CXtIkixDu6fw4wDtNw03ZyNJOhBOXVTgAyOTSlIz3D+6n8CAMeCqEFBHQIVoQpf
+Bza4YvFtJRdfGMTix3u7Cb6y9CHGBok7uUgQAeWnzQvMGTCHc3e8iHGAYBQ88GPF
+v1TpiusCAOroRe69Aiid5JMVTjWoJ0SHKd47nIj0gQFiDfa5de0BNq9gYj7JLg+R
+EjsJbJN39z+Z9HWjIOCUOIXDvucmM1MB/iNxW1Z8mEMflEYK5rop+PDxwqUbr8uZ
+kzogw98ZdmuEuN0bheGWUiJI+0Pd8jb40zlR1KgOEMx1mZchToAJdtybMLQnSm9l
+IFRlc3RlciAodGVzdCBrZXkpIDxqb2VAZXhhbXBsZS5jb20+iLgEEwECACIFAlUQ
+8QgCGwMGCwkIBwMCBhUIAgkKCwQWAgMBAh4BAheAAAoJECixwJYy+7gYZg4D/RnO
+hzbP928C0VUuHii8qo/aqWJC3aqxyEkdU/fSEmcpPt2Yl8mXuTP2ZeYx9K1ibSW5
+iZ5LN15Y5Ez1LKAtFhe4N83obhk8lOWxGGCcBGE3M2FLH5iVwWHjxn5rnNGCgEyf
+sOBhWp9ThS15k5JcyWe4DZnlqjWqAaFWoRJImBTmnQHYBFUQ8QgBBADacLkKD0U1
+1nmlsScxPGkrDr0aJPrG8MEaDRnKjHJKNp3XTp1psGBUpWF/ErjQAIu+psFtLO8o
+wCGsg/vJM7CzTv2dVBRbrZXjIKvdq7HdivosTMaHArQBpEtSO9rmgVHO+jaQq/M2
+oGvNEB86zo3nfTWhOgBiB32m8kttWRiuWQARAQABAAP7B8uNtb/DLvGoRfL+mA0Q
+REhgOJ1WpRcU6rvKYNPh8xTkKMvM+EK0nVU/znBedEpXjb0pY1WRT0uvXs2pzY2V
+YeaugyKIkdUpPWnyWoEQwI8hFvHOWmU2rNHyXLW0MY7bxcGgqv2XbkL4m7/D6VQS
+SR8hQ2CxBbW+9ov6aBMwv/UCAOW89+5xxuzkv48AVraWlMnaU0ggVOf6ht0Qa40+
++uw2yziNlD403gAAAycoICiB/oqwslx61B2xOHn0laCKrgsCAPNpIsHRlAwWbAsq
+uCtfIQxg+C3mPXkqsNTMjeK5NjLNytrmO49NXco36zVEG6q7qz5Zj9d9IPYoGOSa
+I+dQZ6sB/RKF5aonR5/e7IHJgc8BG7I0yiya4llE0AB9ghnRI/3uHwnCBnmo/32a
+n4+rQkx6vm+rg3JA/09Gi7W4R9SwV+ane4ifBBgBAgAJBQJVEPEIAhsMAAoJECix
+wJYy+7gY+OAEAJDCUZu1SVK8qwyhbXyH8rUMf75slP3GXFVeiKSqjyoc7YEfkA/X
+M5R70Ic/st4arS0UobthMn++XTXsXFLyrP5UuCyA14OVe6VkkZPXkBuNN5rqkfzR
+ruvkJlMdPayZe9ra3WhsTZMhwO2cu2QxpHDL0LHd6qEjRrD0eUynrMO0
+=iCIm
+-----END PGP PRIVATE KEY BLOCK-----
(if (next-method-p) (call-next-method))
)
-(defmethod eieio-constructor :STATIC ((p C-base2) &rest args)
+(defmethod make-instance :STATIC ((p C-base2) &rest args)
(eieio-test-method-store :STATIC 'C-base2)
(if (next-method-p) (call-next-method))
)
-(defmethod eieio-constructor :STATIC ((p C) &rest args)
+(cl-defmethod make-instance ((p (subclass C)) &rest args)
(eieio-test-method-store :STATIC 'C)
(call-next-method)
)
(eieio-persistent-save original)
- (let* ((file (oref original :file))
+ (let* ((file (oref original file))
(class (eieio-object-class original))
(fromdisk (eieio-persistent-read file class))
(cv (eieio--class-v class))
- (slot-names (eieio--class-public-a cv))
- (slot-deflt (eieio--class-public-d cv))
+ (slots (eieio--class-slots cv))
)
(unless (object-of-class-p fromdisk class)
(error "Persistent class %S != original class %S"
(eieio-object-class fromdisk)
class))
- (while slot-names
- (let* ((oneslot (car slot-names))
+ (dotimes (i (length slots))
+ (let* ((slot (aref slots i))
+ (oneslot (cl--slot-descriptor-name slot))
(origvalue (eieio-oref original oneslot))
(fromdiskvalue (eieio-oref fromdisk oneslot))
(initarg-p (eieio--attribute-to-initarg
(error "Slot %S Original Val %S != Persistent Val %S"
oneslot origvalue fromdiskvalue))
;; Else !initarg-p
- (unless (equal (car slot-deflt) fromdiskvalue)
+ (unless (equal (cl--slot-descriptor-initform slot) fromdiskvalue)
(error "Slot %S Persistent Val %S != Default Value %S"
- oneslot fromdiskvalue (car slot-deflt))))
-
- (setq slot-names (cdr slot-names)
- slot-deflt (cdr slot-deflt))
+ oneslot fromdiskvalue (cl--slot-descriptor-initform slot))))
))))
;;; Simple Case
(ert-deftest eieio-test-17-virtual-slot ()
(setq eitest-vsca (virtual-slot-class :base-value 1))
;; Check slot values
- (should (= (oref eitest-vsca :base-value) 1))
+ (should (= (oref eitest-vsca base-value) 1))
(should (= (oref eitest-vsca :derived-value) 2))
- (oset eitest-vsca :derived-value 3)
- (should (= (oref eitest-vsca :base-value) 2))
+ (oset eitest-vsca derived-value 3)
+ (should (= (oref eitest-vsca base-value) 2))
(should (= (oref eitest-vsca :derived-value) 3))
- (oset eitest-vsca :base-value 3)
- (should (= (oref eitest-vsca :base-value) 3))
+ (oset eitest-vsca base-value 3)
+ (should (= (oref eitest-vsca base-value) 3))
(should (= (oref eitest-vsca :derived-value) 4))
;; should also be possible to initialize instance using virtual slot
(setq eitest-vscb (virtual-slot-class :derived-value 5))
- (should (= (oref eitest-vscb :base-value) 4))
+ (should (= (oref eitest-vscb base-value) 4))
(should (= (oref eitest-vscb :derived-value) 5)))
(ert-deftest eieio-test-18-slot-unbound ()
(setq eitest-t1 (class-c))
;; Slot initialization
(should (eq (oref eitest-t1 slot-1) 'moose))
- (should (eq (oref eitest-t1 :moose) 'moose))
+ ;; Accessing via the initarg name is deprecated!
+ ;; (should (eq (oref eitest-t1 :moose) 'moose))
;; Don't pass reference of private slot
;;PRIVATE (should-error (oref eitest-t1 slot-2) :type 'invalid-slot-name)
;; Check private slot accessor
;; See previous test, nor for subclass
(setq eitest-t2 (class-subc))
(should (eq (oref eitest-t2 slot-1) 'moose))
- (should (eq (oref eitest-t2 :moose) 'moose))
+ ;; Accessing via the initarg name is deprecated!
+ ;;(should (eq (oref eitest-t2 :moose) 'moose))
(should (string= (get-slot-2 eitest-t2) "linux"))
;;PRIVATE (should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name)
(should (string= (get-slot-2 eitest-t2) "linux"))
(ert-deftest eieio-test-32-slot-attribute-override-2 ()
(let* ((cv (eieio--class-v 'slotattr-ok))
- (docs (eieio--class-public-doc cv))
- (names (eieio--class-public-a cv))
- (cust (eieio--class-public-custom cv))
- (label (eieio--class-public-custom-label cv))
- (group (eieio--class-public-custom-group cv))
- (types (eieio--class-public-type cv))
- (args (eieio--class-initarg-tuples cv))
- (i 0))
+ (slots (eieio--class-slots cv))
+ (args (eieio--class-initarg-tuples cv)))
;; :initarg should override for subclass
(should (assoc :initblarg args))
- (while (< i (length names))
- (cond
- ((eq (nth i names) 'custom)
- ;; Custom slot attributes must override
- (should (eq (nth i cust) 'string))
- ;; Custom label slot attribute must override
- (should (string= (nth i label) "One String"))
- (let ((grp (nth i group)))
- ;; Custom group slot attribute must combine
- (should (and (memq 'moose grp) (memq 'cow grp)))))
- (t nil))
-
- (setq i (1+ i)))))
+ (dotimes (i (length slots))
+ (let* ((slot (aref slots i))
+ (props (cl--slot-descriptor-props slot)))
+ (cond
+ ((eq (cl--slot-descriptor-name slot) 'custom)
+ ;; Custom slot attributes must override
+ (should (eq (alist-get :custom props) 'string))
+ ;; Custom label slot attribute must override
+ (should (string= (alist-get :label props) "One String"))
+ (let ((grp (alist-get :group props)))
+ ;; Custom group slot attribute must combine
+ (should (and (memq 'moose grp) (memq 'cow grp)))))
+ (t nil))))))
(defvar eitest-CLONETEST1 nil)
(defvar eitest-CLONETEST2 nil)
(should (= (length (eieio-build-class-alist 'opt-test1 nil)) 2))
(should (= (length (eieio-build-class-alist 'opt-test1 t)) 1)))
-(defclass eieio--testing ()
- ())
+(defclass eieio--testing () ())
(defmethod constructor :static ((_x eieio--testing) newname &rest _args)
(list newname 2))
--- /dev/null
+;;; epg-tests.el --- Test suite for epg.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2013-2015 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 'ert)
+(require 'epg)
+
+(defvar epg-tests-context nil)
+
+(defvar epg-tests-data-directory
+ (expand-file-name "data/epg" (getenv "EMACS_TEST_DIRECTORY"))
+ "Directory containing epg test data.")
+
+(defun epg-tests-gpg-usable (&optional require-passphrase)
+ (and (executable-find epg-gpg-program)
+ (condition-case nil
+ (progn
+ (epg-check-configuration (epg-configuration))
+ (if require-passphrase
+ (string-match "\\`1\\."
+ (cdr (assq 'version (epg-configuration))))
+ t))
+ (error nil))))
+
+(defun epg-tests-passphrase-callback (_c _k _d)
+ ;; Need to create a copy here, since the string will be wiped out
+ ;; after the use.
+ (copy-sequence "test0123456789"))
+
+(cl-defmacro with-epg-tests ((&optional &key require-passphrase
+ require-public-key
+ require-secret-key)
+ &rest body)
+ "Set up temporary locations and variables for testing."
+ (declare (indent 1))
+ `(let* ((epg-tests-home-directory (make-temp-file "epg-tests-homedir" t)))
+ (unwind-protect
+ (let ((context (epg-make-context 'OpenPGP)))
+ (setf (epg-context-home-directory context)
+ epg-tests-home-directory)
+ (setenv "GPG_AGENT_INFO")
+ ,(if require-passphrase
+ `(epg-context-set-passphrase-callback
+ context
+ #'epg-tests-passphrase-callback))
+ ,(if require-public-key
+ `(epg-import-keys-from-file
+ context
+ (expand-file-name "pubkey.asc" epg-tests-data-directory)))
+ ,(if require-secret-key
+ `(epg-import-keys-from-file
+ context
+ (expand-file-name "seckey.asc" epg-tests-data-directory)))
+ (with-temp-buffer
+ (make-local-variable 'epg-tests-context)
+ (setq epg-tests-context context)
+ ,@body))
+ (when (file-directory-p epg-tests-home-directory)
+ (delete-directory epg-tests-home-directory t)))))
+
+(ert-deftest epg-decrypt-1 ()
+ (skip-unless (epg-tests-gpg-usable 'require-passphrase))
+ (with-epg-tests (:require-passphrase t)
+ (should (equal "test"
+ (epg-decrypt-string epg-tests-context "\
+-----BEGIN PGP MESSAGE-----
+Version: GnuPG v2
+
+jA0EAwMCE19JBLTvvmhgyRrGGglRbnKkK9PJG8fDwO5ccjysrR7IcdNcnA==
+=U8z7
+-----END PGP MESSAGE-----")))))
+
+(ert-deftest epg-roundtrip-1 ()
+ (skip-unless (epg-tests-gpg-usable 'require-passphrase))
+ (with-epg-tests (:require-passphrase t)
+ (let ((cipher (epg-encrypt-string epg-tests-context "symmetric" nil)))
+ (should (equal "symmetric"
+ (epg-decrypt-string epg-tests-context cipher))))))
+
+(ert-deftest epg-roundtrip-2 ()
+ (skip-unless (epg-tests-gpg-usable 'require-passphrase))
+ (with-epg-tests (:require-passphrase t
+ :require-public-key t
+ :require-secret-key t)
+ (let* ((recipients (epg-list-keys epg-tests-context "joe@example.com"))
+ (cipher (epg-encrypt-string epg-tests-context "public key"
+ recipients nil t)))
+ (should (equal "public key"
+ (epg-decrypt-string epg-tests-context cipher))))))
+
+(ert-deftest epg-sign-verify-1 ()
+ (skip-unless (epg-tests-gpg-usable 'require-passphrase))
+ (with-epg-tests (:require-passphrase t
+ :require-public-key t
+ :require-secret-key t)
+ (let (signature verify-result)
+ (setf (epg-context-signers epg-tests-context)
+ (epg-list-keys epg-tests-context "joe@example.com"))
+ (setq signature (epg-sign-string epg-tests-context "signed" t))
+ (epg-verify-string epg-tests-context signature "signed")
+ (setq verify-result (epg-context-result-for context 'verify))
+ (should (= 1 (length verify-result)))
+ (should (eq 'good (epg-signature-status (car verify-result)))))))
+
+(ert-deftest epg-sign-verify-2 ()
+ (skip-unless (epg-tests-gpg-usable 'require-passphrase))
+ (with-epg-tests (:require-passphrase t
+ :require-public-key t
+ :require-secret-key t)
+ (let (signature verify-result)
+ (setf (epg-context-signers epg-tests-context)
+ (epg-list-keys epg-tests-context "joe@example.com"))
+ (setq signature (epg-sign-string epg-tests-context "clearsigned" 'clear))
+ ;; Clearsign signature always ends with a new line.
+ (should (equal "clearsigned\n"
+ (epg-verify-string epg-tests-context signature)))
+ (setq verify-result (epg-context-result-for context 'verify))
+ (should (= 1 (length verify-result)))
+ (should (eq 'good (epg-signature-status (car verify-result)))))))
+
+(ert-deftest epg-sign-verify-3 ()
+ (skip-unless (epg-tests-gpg-usable 'require-passphrase))
+ (with-epg-tests (:require-passphrase t
+ :require-public-key t
+ :require-secret-key t)
+ (let (signature verify-result)
+ (setf (epg-context-signers epg-tests-context)
+ (epg-list-keys epg-tests-context "joe@example.com"))
+ (setq signature (epg-sign-string epg-tests-context "normal signed"))
+ (should (equal "normal signed"
+ (epg-verify-string epg-tests-context signature)))
+ (setq verify-result (epg-context-result-for context 'verify))
+ (should (= 1 (length verify-result)))
+ (should (eq 'good (epg-signature-status (car verify-result)))))))
+
+(ert-deftest epg-import-1 ()
+ (skip-unless (epg-tests-gpg-usable 'require-passphrase))
+ (with-epg-tests (:require-passphrase nil)
+ (should (= 0 (length (epg-list-keys epg-tests-context))))
+ (should (= 0 (length (epg-list-keys epg-tests-context nil t)))))
+ (with-epg-tests (:require-passphrase nil
+ :require-public-key t)
+ (should (= 1 (length (epg-list-keys epg-tests-context))))
+ (should (= 0 (length (epg-list-keys epg-tests-context nil t)))))
+ (with-epg-tests (:require-public-key nil
+ :require-public-key t
+ :require-secret-key t)
+ (should (= 1 (length (epg-list-keys epg-tests-context))))
+ (should (= 1 (length (epg-list-keys epg-tests-context nil t))))))
+
+(provide 'epg-tests)
+
+;;; epg-tests.el ends here
(f90-indent-subprogram)
(should (= 0 (current-indentation)))))
+(ert-deftest f90-test-bug-19809 ()
+ "Test for http://debbugs.gnu.org/19809 ."
+ (with-temp-buffer
+ (f90-mode)
+ ;; The Fortran standard says that continued strings should have
+ ;; '&' at the start of continuation lines, but it seems gfortran
+ ;; allows them to be absent (albeit with a warning).
+ (insert "program prog
+ write (*,*), '&
+end program prog'
+end program prog")
+ (goto-char (point-min))
+ (f90-end-of-subprogram)
+ (should (= (point) (point-max)))))
+
+
;;; f90.el ends here
--- /dev/null
+;;; finalizer-tests.el --- Finalizer tests -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Daniel Colascione <dancol@dancol.org>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'cl-lib)
+
+(ert-deftest finalizer-basic ()
+ "Test that finalizers run at all."
+ (skip-unless gc-precise)
+ (let* ((finalized nil)
+ (finalizer (make-finalizer (lambda () (setf finalized t)))))
+ (garbage-collect)
+ (should (equal finalized nil))
+ (setf finalizer nil)
+ (garbage-collect)
+ (should (equal finalized t))))
+
+(ert-deftest finalizer-circular-reference ()
+ "Test references from a callback to a finalizer."
+ (skip-unless gc-precise)
+ (let ((finalized nil))
+ (let* ((value nil)
+ (finalizer (make-finalizer (lambda () (setf finalized value)))))
+ (setf value finalizer)
+ (setf finalizer nil))
+ (garbage-collect)
+ (should finalized)))
+
+(ert-deftest finalizer-cross-reference ()
+ "Test that between-finalizer references do not prevent collection."
+ (skip-unless gc-precise)
+ (let ((d nil) (fc 0))
+ (let* ((f1-data (cons nil nil))
+ (f2-data (cons nil nil))
+ (f1 (make-finalizer
+ (lambda () (cl-incf fc) (setf d f1-data))))
+ (f2 (make-finalizer
+ (lambda () (cl-incf fc) (setf d f2-data)))))
+ (setcar f1-data f2)
+ (setcar f2-data f1))
+ (garbage-collect)
+ (should (equal fc 2))))
+
+(ert-deftest finalizer-error ()
+ "Test that finalizer errors are suppressed"
+ (skip-unless gc-precise)
+ (make-finalizer (lambda () (error "ABCDEF")))
+ (garbage-collect)
+ (with-current-buffer "*Messages*"
+ (save-excursion
+ (goto-char (point-max))
+ (forward-line -1)
+ (should (equal
+ (buffer-substring (point) (point-at-eol))
+ "finalizer failed: (error \"ABCDEF\")")))))
+
+(ert-deftest finalizer-object-type ()
+ (should (equal (type-of (make-finalizer nil)) 'finalizer)))
--- /dev/null
+;;; generator-tests.el --- Testing generators -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Daniel Colascione <dancol@dancol.org>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+(require 'generator)
+(require 'ert)
+(require 'cl-lib)
+
+(defun generator-list-subrs ()
+ (cl-loop for x being the symbols
+ when (and (fboundp x)
+ (cps--special-form-p (symbol-function x)))
+ collect x))
+
+(defmacro cps-testcase (name &rest body)
+ "Perform a simple test of the continuation-transforming code.
+
+`cps-testcase' defines an ERT testcase called NAME that evaluates
+BODY twice: once using ordinary `eval' and once using
+lambda-generators. The test ensures that the two forms produce
+identical output.
+"
+ `(progn
+ (ert-deftest ,name ()
+ (should
+ (equal
+ (funcall (lambda () ,@body))
+ (iter-next
+ (funcall
+ (iter-lambda () (iter-yield (progn ,@body))))))))
+ (ert-deftest ,(intern (format "%s-noopt" name)) ()
+ (should
+ (equal
+ (funcall (lambda () ,@body))
+ (iter-next
+ (funcall
+ (let ((cps-inhibit-atomic-optimization t))
+ (iter-lambda () (iter-yield (progn ,@body)))))))))))
+
+(put 'cps-testcase 'lisp-indent-function 1)
+
+(defvar *cps-test-i* nil)
+(defun cps-get-test-i ()
+ *cps-test-i*)
+
+(cps-testcase cps-simple-1 (progn 1 2 3))
+(cps-testcase cps-empty-progn (progn))
+(cps-testcase cps-inline-not-progn (inline 1 2 3))
+(cps-testcase cps-prog1-a (prog1 1 2 3))
+(cps-testcase cps-prog1-b (prog1 1))
+(cps-testcase cps-prog1-c (prog2 1 2 3))
+(cps-testcase cps-quote (progn 'hello))
+(cps-testcase cps-function (progn #'hello))
+
+(cps-testcase cps-and-fail (and 1 nil 2))
+(cps-testcase cps-and-succeed (and 1 2 3))
+(cps-testcase cps-and-empty (and))
+
+(cps-testcase cps-or-fallthrough (or nil 1 2))
+(cps-testcase cps-or-alltrue (or 1 2 3))
+(cps-testcase cps-or-empty (or))
+
+(cps-testcase cps-let* (let* ((i 10)) i))
+(cps-testcase cps-let*-shadow-empty (let* ((i 10)) (let (i) i)))
+(cps-testcase cps-let (let ((i 10)) i))
+(cps-testcase cps-let-shadow-empty (let ((i 10)) (let (i) i)))
+(cps-testcase cps-let-novars (let nil 42))
+(cps-testcase cps-let*-novars (let* nil 42))
+
+(cps-testcase cps-let-parallel
+ (let ((a 5) (b 6)) (let ((a b) (b a)) (list a b))))
+
+(cps-testcase cps-let*-parallel
+ (let* ((a 5) (b 6)) (let* ((a b) (b a)) (list a b))))
+
+(cps-testcase cps-while-dynamic
+ (setq *cps-test-i* 0)
+ (while (< *cps-test-i* 10)
+ (setf *cps-test-i* (+ *cps-test-i* 1)))
+ *cps-test-i*)
+
+(cps-testcase cps-while-lexical
+ (let* ((i 0) (j 10))
+ (while (< i 10)
+ (setf i (+ i 1))
+ (setf j (+ j (* i 10))))
+ j))
+
+(cps-testcase cps-while-incf
+ (let* ((i 0) (j 10))
+ (while (< i 10)
+ (cl-incf i)
+ (setf j (+ j (* i 10))))
+ j))
+
+(cps-testcase cps-dynbind
+ (setf *cps-test-i* 0)
+ (let* ((*cps-test-i* 5))
+ (cps-get-test-i)))
+
+(cps-testcase cps-nested-application
+ (+ (+ 3 5) 1))
+
+(cps-testcase cps-unwind-protect
+ (setf *cps-test-i* 0)
+ (unwind-protect
+ (setf *cps-test-i* 1)
+ (setf *cps-test-i* 2))
+ *cps-test-i*)
+
+(cps-testcase cps-catch-unused
+ (catch 'mytag 42))
+
+(cps-testcase cps-catch-thrown
+ (1+ (catch 'mytag
+ (throw 'mytag (+ 2 2)))))
+
+(cps-testcase cps-loop
+ (cl-loop for x from 1 to 10 collect x))
+
+(cps-testcase cps-loop-backquote
+ `(a b ,(cl-loop for x from 1 to 10 collect x) -1))
+
+(cps-testcase cps-if-branch-a
+ (if t 'abc))
+
+(cps-testcase cps-if-branch-b
+ (if t 'abc 'def))
+
+(cps-testcase cps-if-condition-fail
+ (if nil 'abc 'def))
+
+(cps-testcase cps-cond-empty
+ (cond))
+
+(cps-testcase cps-cond-atomi
+ (cond (42)))
+
+(cps-testcase cps-cond-complex
+ (cond (nil 22) ((1+ 1) 42) (t 'bad)))
+
+(put 'cps-test-error 'error-conditions '(cps-test-condition))
+
+(cps-testcase cps-condition-case
+ (condition-case
+ condvar
+ (signal 'cps-test-error 'test-data)
+ (cps-test-condition condvar)))
+
+(cps-testcase cps-condition-case-no-error
+ (condition-case
+ condvar
+ 42
+ (cps-test-condition condvar)))
+
+(ert-deftest cps-generator-basic ()
+ (let* ((gen (iter-lambda ()
+ (iter-yield 1)
+ (iter-yield 2)
+ (iter-yield 3)
+ 4))
+ (gen-inst (funcall gen)))
+ (should (eql (iter-next gen-inst) 1))
+ (should (eql (iter-next gen-inst) 2))
+ (should (eql (iter-next gen-inst) 3))
+
+ ;; should-error doesn't catch the generator-end condition (which
+ ;; isn't an error), so we write our own.
+ (let (errored)
+ (condition-case x
+ (iter-next gen-inst)
+ (iter-end-of-sequence
+ (setf errored (cdr x))))
+ (should (eql errored 4)))))
+
+(iter-defun mygenerator (i)
+ (iter-yield 1)
+ (iter-yield i)
+ (iter-yield 2))
+
+(ert-deftest cps-test-iter-do ()
+ (let (mylist)
+ (iter-do (x (mygenerator 4))
+ (push x mylist))
+ (should (equal mylist '(2 4 1)))))
+
+(iter-defun gen-using-yield-value ()
+ (let (f)
+ (setf f (iter-yield 42))
+ (iter-yield f)
+ -8))
+
+(ert-deftest cps-yield-value ()
+ (let ((it (gen-using-yield-value)))
+ (should (eql (iter-next it -1) 42))
+ (should (eql (iter-next it -1) -1))))
+
+(ert-deftest cps-loop ()
+ (should
+ (equal (cl-loop for x iter-by (mygenerator 42)
+ collect x)
+ '(1 42 2))))
+
+(iter-defun gen-using-yield-from ()
+ (let ((sub-iter (gen-using-yield-value)))
+ (iter-yield (1+ (iter-yield-from sub-iter)))))
+
+(ert-deftest cps-test-yield-from-works ()
+ (let ((it (gen-using-yield-from)))
+ (should (eql (iter-next it -1) 42))
+ (should (eql (iter-next it -1) -1))
+ (should (eql (iter-next it -1) -7))))
+
+(defvar cps-test-closed-flag nil)
+
+(ert-deftest cps-test-iter-close ()
+ (garbage-collect)
+ (let ((cps-test-closed-flag nil))
+ (let ((iter (funcall
+ (iter-lambda ()
+ (unwind-protect (iter-yield 1)
+ (setf cps-test-closed-flag t))))))
+ (should (equal (iter-next iter) 1))
+ (should (not cps-test-closed-flag))
+ (iter-close iter)
+ (should cps-test-closed-flag))))
+
+(ert-deftest cps-test-iter-close-idempotent ()
+ (garbage-collect)
+ (let ((cps-test-closed-flag nil))
+ (let ((iter (funcall
+ (iter-lambda ()
+ (unwind-protect (iter-yield 1)
+ (setf cps-test-closed-flag t))))))
+ (should (equal (iter-next iter) 1))
+ (should (not cps-test-closed-flag))
+ (iter-close iter)
+ (should cps-test-closed-flag)
+ (setf cps-test-closed-flag nil)
+ (iter-close iter)
+ (should (not cps-test-closed-flag)))))
+
+(ert-deftest cps-test-iter-close-finalizer ()
+ (skip-unless gc-precise)
+ (garbage-collect)
+ (let ((cps-test-closed-flag nil))
+ (let ((iter (funcall
+ (iter-lambda ()
+ (unwind-protect (iter-yield 1)
+ (setf cps-test-closed-flag t))))))
+ (should (equal (iter-next iter) 1))
+ (should (not cps-test-closed-flag))
+ (setf iter nil)
+ (garbage-collect)
+ (should cps-test-closed-flag))))
+
+(ert-deftest cps-test-iter-cleanup-once-only ()
+ (let* ((nr-unwound 0)
+ (iter
+ (funcall (iter-lambda ()
+ (unwind-protect
+ (progn
+ (iter-yield 1)
+ (error "test")
+ (iter-yield 2))
+ (cl-incf nr-unwound))))))
+ (should (equal (iter-next iter) 1))
+ (should-error (iter-next iter))
+ (should (equal nr-unwound 1))))
+
+(iter-defun generator-with-docstring ()
+ "Documentation!"
+ (declare (indent 5))
+ nil)
+
+(ert-deftest cps-test-declarations-preserved ()
+ (should (equal (documentation 'generator-with-docstring) "Documentation!"))
+ (should (equal (get 'generator-with-docstring 'lisp-indent-function) 5)))
--- /dev/null
+;;; json-tests.el --- Test suite for json.el
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Dmitry Gutov <dgutov@yandex.ru>
+
+;; 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/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'json)
+
+(ert-deftest json-encode-simple-alist ()
+ (should (equal (json-encode '((a . 1)
+ (b . 2)))
+ "{\"a\":1,\"b\":2}")))
+
+(ert-deftest json-read-simple-alist ()
+ (should (equal (json-read-from-string "{\"a\": 1, \"b\": 2}")
+ '((b . 2)
+ (a . 1)))))
+
+(ert-deftest json-encode-string-with-special-chars ()
+ (should (equal (json-encode-string "a\n\fb")
+ "\"a\\n\\fb\""))
+ (should (equal (json-encode-string "\nasdфыв\u001f\u007ffgh\t")
+ "\"\\nasdфыв\\u001f\u007ffgh\\t\"")))
+
+(ert-deftest json-read-string-with-special-chars ()
+ (should (equal (json-read-from-string "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"")
+ "\nasdфывfgh\t")))
+
+(provide 'json-tests)
+;;; json-tests.el ends here
(require 'ert)
(require 'cl-lib)
+(setq package-menu-async nil)
+
(defvar package-test-user-dir nil
"Directory to use for installing packages during testing.")
:kind 'single)
"Expected `package-desc' parsed from new-pkg-1.0.el.")
+(defvar simple-depend-desc-1
+ (package-desc-create :name 'simple-depend-1
+ :version '(1 0)
+ :summary "A single-file package with a dependency."
+ :kind 'single
+ :reqs '((simple-depend (1 0))
+ (multi-file (0 1))))
+ "`package-desc' used for testing dependencies.")
+
+(defvar simple-depend-desc-2
+ (package-desc-create :name 'simple-depend-2
+ :version '(1 0)
+ :summary "A single-file package with a dependency."
+ :kind 'single
+ :reqs '((simple-depend-1 (1 0))
+ (multi-file (0 1))))
+ "`package-desc' used for testing dependencies.")
+
(defvar package-test-data-dir (expand-file-name "data/package" package-test-file-dir)
"Base directory of package test files.")
;; New version should be available and old version should be installed
(goto-char (point-min))
- (should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+new" nil t))
+ (should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+available" nil t))
(should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t))
(goto-char (point-min))
;; Check if the installed package status is updated.
(let ((buf (package-list-packages)))
(package-menu-refresh)
- (should (re-search-forward "^\\s-+signed-good\\s-+1\\.0\\s-+installed"
- nil t)))
+ (should (re-search-forward
+ "^\\s-+signed-good\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-"
+ nil t))
+ (should (string-equal (match-string-no-properties 1) "1.0"))
+ (should (string-equal (match-string-no-properties 2) "installed")))
;; Check if the package description is updated.
(with-fake-help-buffer
(describe-package 'signed-good)
(goto-char (point-min))
- (should (search-forward "signed-good is an installed package." nil t))
+ (should (re-search-forward "signed-good is an? \\(\\S-+\\) package." nil t))
+ (should (string-equal (match-string-no-properties 1) "installed"))
(should (search-forward
"Status: Installed in `~/signed-good-1.0/'."
nil t))))))
(should (equal archive-contents
(list 1 package-x-test--single-archive-entry-1-4))))))
+(ert-deftest package-test-get-deps ()
+ "Test `package--get-deps' with complex structures."
+ (let ((package-alist
+ (mapcar (lambda (p) (list (package-desc-name p) p))
+ (list simple-single-desc
+ simple-depend-desc
+ multi-file-desc
+ new-pkg-desc
+ simple-depend-desc-1
+ simple-depend-desc-2))))
+ (should
+ (equal (package--get-deps 'simple-depend)
+ '(simple-single)))
+ (should
+ (equal (package--get-deps 'simple-depend 'indirect)
+ nil))
+ (should
+ (equal (package--get-deps 'simple-depend 'direct)
+ '(simple-single)))
+ (should
+ (equal (package--get-deps 'simple-depend-2)
+ '(simple-depend-1 multi-file simple-depend simple-single)))
+ (should
+ (equal (package--get-deps 'simple-depend-2 'indirect)
+ '(simple-depend multi-file simple-single)))
+ (should
+ (equal (package--get-deps 'simple-depend-2 'direct)
+ '(simple-depend-1 multi-file)))))
+
+(ert-deftest package-test-sort-by-dependence ()
+ "Test `package--sort-by-dependence' with complex structures."
+ (let ((package-alist
+ (mapcar (lambda (p) (list (package-desc-name p) p))
+ (list simple-single-desc
+ simple-depend-desc
+ multi-file-desc
+ new-pkg-desc
+ simple-depend-desc-1
+ simple-depend-desc-2)))
+ (delete-list
+ (list simple-single-desc
+ simple-depend-desc
+ multi-file-desc
+ new-pkg-desc
+ simple-depend-desc-1
+ simple-depend-desc-2)))
+ (should
+ (equal (package--sort-by-dependence delete-list)
+ (list simple-depend-desc-2 simple-depend-desc-1 new-pkg-desc
+ multi-file-desc simple-depend-desc simple-single-desc)))
+ (should
+ (equal (package--sort-by-dependence (reverse delete-list))
+ (list new-pkg-desc simple-depend-desc-2 simple-depend-desc-1
+ multi-file-desc simple-depend-desc simple-single-desc)))))
+
(provide 'package-test)
;;; package-test.el ends here
(require 'ert)
(require 'python)
+;; Dependencies for testing:
+(require 'electric)
+(require 'hideshow)
+
+
(defmacro python-tests-with-temp-buffer (contents &rest body)
"Create a `python-mode' enabled temp buffer with CONTENTS.
BODY is code to be executed within the temp buffer. Point is
(call-interactively 'self-insert-command)))
chars)))
+(defun python-tests-visible-string (&optional min max)
+ "Return the buffer string excluding invisible overlays.
+Argument MIN and MAX delimit the region to be returned and
+default to `point-min' and `point-max' respectively."
+ (let* ((min (or min (point-min)))
+ (max (or max (point-max)))
+ (buffer (current-buffer))
+ (buffer-contents (buffer-substring-no-properties min max))
+ (overlays
+ (sort (overlays-in min max)
+ (lambda (a b)
+ (let ((overlay-end-a (overlay-end a))
+ (overlay-end-b (overlay-end b)))
+ (> overlay-end-a overlay-end-b))))))
+ (with-temp-buffer
+ (insert buffer-contents)
+ (dolist (overlay overlays)
+ (if (overlay-get overlay 'invisible)
+ (delete-region (overlay-start overlay)
+ (overlay-end overlay))))
+ (buffer-substring-no-properties (point-min) (point-max)))))
+
\f
;;; Tests for your tests, so you can test while you test.
(should (eq (car (python-indent-context)) :no-indent))
(should (= (python-indent-calculate-indentation) 0))
(python-tests-look-at "foo = long_function_name(var_one, var_two,")
- (should (eq (car (python-indent-context)) :after-line))
+ (should (eq (car (python-indent-context)) :after-comment))
(should (= (python-indent-calculate-indentation) 0))
(python-tests-look-at "var_three, var_four)")
(should (eq (car (python-indent-context)) :inside-paren))
(should (eq (car (python-indent-context)) :no-indent))
(should (= (python-indent-calculate-indentation) 0))
(python-tests-look-at "def long_function_name(")
- (should (eq (car (python-indent-context)) :after-line))
+ (should (eq (car (python-indent-context)) :after-comment))
(should (= (python-indent-calculate-indentation) 0))
(python-tests-look-at "var_one, var_two, var_three,")
(should (eq (car (python-indent-context))
(should (eq (car (python-indent-context)) :no-indent))
(should (= (python-indent-calculate-indentation) 0))
(python-tests-look-at "foo = long_function_name(")
- (should (eq (car (python-indent-context)) :after-line))
+ (should (eq (car (python-indent-context)) :after-comment))
(should (= (python-indent-calculate-indentation) 0))
(python-tests-look-at "var_one, var_two,")
(should (eq (car (python-indent-context)) :inside-paren-newline-start))
def func(arg):
# I don't do much
return arg
- # This comment is badly indented just because.
- # But we won't mess with the user in this line.
+ # This comment is badly indented because the user forced so.
+ # At this line python.el wont dedent, user is always right.
-now_we_do_mess_cause_this_is_not_a_comment = 1
+comment_wins_over_ender = True
# yeah, that.
"
;; the rules won't apply here.
(should (eq (car (python-indent-context)) :after-block-start))
(should (= (python-indent-calculate-indentation) 4))
- (python-tests-look-at "# This comment is badly")
+ (python-tests-look-at "# This comment is badly indented")
(should (eq (car (python-indent-context)) :after-block-end))
- ;; The return keyword moves indentation backwards 4 spaces, but
- ;; let's assume this comment was placed there because the user
- ;; wanted to (manually adding spaces or whatever).
+ ;; The return keyword do make indentation lose a level...
(should (= (python-indent-calculate-indentation) 0))
- (python-tests-look-at "# but we won't mess")
+ ;; ...but the current indentation was forced by the user.
+ (python-tests-look-at "# At this line python.el wont dedent")
(should (eq (car (python-indent-context)) :after-comment))
(should (= (python-indent-calculate-indentation) 4))
- ;; Behave the same for blank lines: potentially a comment.
+ ;; Should behave the same for blank lines: potentially a comment.
(forward-line 1)
(should (eq (car (python-indent-context)) :after-comment))
(should (= (python-indent-calculate-indentation) 4))
- (python-tests-look-at "now_we_do_mess")
- ;; Here is where comment indentation starts to get ignored and
- ;; where the user can't freely indent anymore.
- (should (eq (car (python-indent-context)) :after-block-end))
- (should (= (python-indent-calculate-indentation) 0))
+ (python-tests-look-at "comment_wins_over_ender")
+ ;; The comment won over the ender because the user said so.
+ (should (eq (car (python-indent-context)) :after-comment))
+ (should (= (python-indent-calculate-indentation) 4))
+ ;; The indentation calculated fine for the assignment, but the user
+ ;; choose to force it back to the first column. Next line should
+ ;; be aware of that.
(python-tests-look-at "# yeah, that.")
(should (eq (car (python-indent-context)) :after-line))
(should (= (python-indent-calculate-indentation) 0))))
+(ert-deftest python-indent-after-comment-3 ()
+ "Test after-comment in buggy case."
+ (python-tests-with-temp-buffer
+ "
+class A(object):
+
+ def something(self, arg):
+ if True:
+ return arg
+
+ # A comment
+
+ @adecorator
+ def method(self, a, b):
+ pass
+"
+ (python-tests-look-at "@adecorator")
+ (should (eq (car (python-indent-context)) :after-comment))
+ (should (= (python-indent-calculate-indentation) 4))))
+
(ert-deftest python-indent-inside-paren-1 ()
"The most simple inside-paren case that shouldn't fail."
(python-tests-with-temp-buffer
(call-interactively #'python-indent-dedent-line-backspace)
(should (zerop (current-indentation)))))
+(ert-deftest python-indent-dedent-line-backspace-2 ()
+ "Check de-indentation with tabs. Bug#19730."
+ (let ((tab-width 8))
+ (python-tests-with-temp-buffer
+ "
+if x:
+\tabcdefg
+"
+ (python-tests-look-at "abcdefg")
+ (goto-char (line-end-position))
+ (call-interactively #'python-indent-dedent-line-backspace)
+ (should
+ (string= (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position))
+ "\tabcdef")))))
+
+(ert-deftest python-indent-dedent-line-backspace-3 ()
+ "Paranoid check of de-indentation with tabs. Bug#19730."
+ (let ((tab-width 8))
+ (python-tests-with-temp-buffer
+ "
+if x:
+\tif y:
+\t abcdefg
+"
+ (python-tests-look-at "abcdefg")
+ (goto-char (line-end-position))
+ (call-interactively #'python-indent-dedent-line-backspace)
+ (should
+ (string= (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position))
+ "\t abcdef"))
+ (back-to-indentation)
+ (call-interactively #'python-indent-dedent-line-backspace)
+ (should
+ (string= (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position))
+ "\tabcdef"))
+ (call-interactively #'python-indent-dedent-line-backspace)
+ (should
+ (string= (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position))
+ " abcdef"))
+ (call-interactively #'python-indent-dedent-line-backspace)
+ (should
+ (string= (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position))
+ "abcdef")))))
+
\f
;;; Shell integration
\f
;;; Eldoc
+(ert-deftest python-eldoc--get-symbol-at-point-1 ()
+ "Test paren handling."
+ (python-tests-with-temp-buffer
+ "
+map(xx
+map(codecs.open('somefile'
+"
+ (python-tests-look-at "ap(xx")
+ (should (string= (python-eldoc--get-symbol-at-point) "map"))
+ (goto-char (line-end-position))
+ (should (string= (python-eldoc--get-symbol-at-point) "map"))
+ (python-tests-look-at "('somefile'")
+ (should (string= (python-eldoc--get-symbol-at-point) "map"))
+ (goto-char (line-end-position))
+ (should (string= (python-eldoc--get-symbol-at-point) "codecs.open"))))
+
+(ert-deftest python-eldoc--get-symbol-at-point-2 ()
+ "Ensure self is replaced with the class name."
+ (python-tests-with-temp-buffer
+ "
+class TheClass:
+
+ def some_method(self, n):
+ return n
+
+ def other(self):
+ return self.some_method(1234)
+
+"
+ (python-tests-look-at "self.some_method")
+ (should (string= (python-eldoc--get-symbol-at-point)
+ "TheClass.some_method"))
+ (python-tests-look-at "1234)")
+ (should (string= (python-eldoc--get-symbol-at-point)
+ "TheClass.some_method"))))
+
+(ert-deftest python-eldoc--get-symbol-at-point-3 ()
+ "Ensure symbol is found when point is at end of buffer."
+ (python-tests-with-temp-buffer
+ "
+some_symbol
+
+"
+ (goto-char (point-max))
+ (should (string= (python-eldoc--get-symbol-at-point)
+ "some_symbol"))))
+
+(ert-deftest python-eldoc--get-symbol-at-point-4 ()
+ "Ensure symbol is found when point is at whitespace."
+ (python-tests-with-temp-buffer
+ "
+some_symbol some_other_symbol
+"
+ (python-tests-look-at " some_other_symbol")
+ (should (string= (python-eldoc--get-symbol-at-point)
+ "some_symbol"))))
+
\f
;;; Imenu
;;; Electricity
(ert-deftest python-parens-electric-indent-1 ()
- (require 'electric)
(let ((eim electric-indent-mode))
(unwind-protect
(progn
(python-tests-with-temp-buffer
- "
+ "
from django.conf.urls import patterns, include, url
from django.contrib import admin
url(r'^$', views.index
)
"
- (electric-indent-mode 1)
- (python-tests-look-at "views.index")
- (end-of-line)
+ (electric-indent-mode 1)
+ (python-tests-look-at "views.index")
+ (end-of-line)
- ;; Inserting commas within the same line should leave
- ;; indentation unchanged.
- (python-tests-self-insert ",")
- (should (= (current-indentation) 4))
+ ;; Inserting commas within the same line should leave
+ ;; indentation unchanged.
+ (python-tests-self-insert ",")
+ (should (= (current-indentation) 4))
- ;; As well as any other input happening within the same
- ;; set of parens.
- (python-tests-self-insert " name='index')")
- (should (= (current-indentation) 4))
+ ;; As well as any other input happening within the same
+ ;; set of parens.
+ (python-tests-self-insert " name='index')")
+ (should (= (current-indentation) 4))
- ;; But a comma outside it, should trigger indentation.
- (python-tests-self-insert ",")
- (should (= (current-indentation) 23))
+ ;; But a comma outside it, should trigger indentation.
+ (python-tests-self-insert ",")
+ (should (= (current-indentation) 23))
- ;; Newline indents to the first argument column
- (python-tests-self-insert "\n")
- (should (= (current-indentation) 23))
+ ;; Newline indents to the first argument column
+ (python-tests-self-insert "\n")
+ (should (= (current-indentation) 23))
- ;; All this input must not change indentation
- (indent-line-to 4)
- (python-tests-self-insert "url(r'^/login$', views.login)")
- (should (= (current-indentation) 4))
+ ;; All this input must not change indentation
+ (indent-line-to 4)
+ (python-tests-self-insert "url(r'^/login$', views.login)")
+ (should (= (current-indentation) 4))
- ;; But this comma does
- (python-tests-self-insert ",")
- (should (= (current-indentation) 23))))
+ ;; But this comma does
+ (python-tests-self-insert ",")
+ (should (= (current-indentation) 23))))
(or eim (electric-indent-mode -1)))))
(ert-deftest python-triple-quote-pairing ()
- (require 'electric)
(let ((epm electric-pair-mode))
(unwind-protect
(progn
(python-tests-with-temp-buffer
- "\"\"\n"
- (or epm (electric-pair-mode 1))
- (goto-char (1- (point-max)))
- (python-tests-self-insert ?\")
- (should (string= (buffer-string)
- "\"\"\"\"\"\"\n"))
- (should (= (point) 4)))
+ "\"\"\n"
+ (or epm (electric-pair-mode 1))
+ (goto-char (1- (point-max)))
+ (python-tests-self-insert ?\")
+ (should (string= (buffer-string)
+ "\"\"\"\"\"\"\n"))
+ (should (= (point) 4)))
(python-tests-with-temp-buffer
- "\n"
- (python-tests-self-insert (list ?\" ?\" ?\"))
- (should (string= (buffer-string)
- "\"\"\"\"\"\"\n"))
- (should (= (point) 4)))
+ "\n"
+ (python-tests-self-insert (list ?\" ?\" ?\"))
+ (should (string= (buffer-string)
+ "\"\"\"\"\"\"\n"))
+ (should (= (point) 4)))
(python-tests-with-temp-buffer
- "\"\n\"\"\n"
- (goto-char (1- (point-max)))
- (python-tests-self-insert ?\")
- (should (= (point) (1- (point-max))))
- (should (string= (buffer-string)
- "\"\n\"\"\"\n"))))
+ "\"\n\"\"\n"
+ (goto-char (1- (point-max)))
+ (python-tests-self-insert ?\")
+ (should (= (point) (1- (point-max))))
+ (should (string= (buffer-string)
+ "\"\n\"\"\"\n"))))
(or epm (electric-pair-mode -1)))))
+\f
+;;; Hideshow support
+
+(ert-deftest python-hideshow-hide-levels-1 ()
+ "Should hide all methods when called after class start."
+ (let ((enabled hs-minor-mode))
+ (unwind-protect
+ (progn
+ (python-tests-with-temp-buffer
+ "
+class SomeClass:
+
+ def __init__(self, arg, kwarg=1):
+ self.arg = arg
+ self.kwarg = kwarg
+
+ def filter(self, nums):
+ def fn(item):
+ return item in [self.arg, self.kwarg]
+ return filter(fn, nums)
+
+ def __str__(self):
+ return '%s-%s' % (self.arg, self.kwarg)
+"
+ (hs-minor-mode 1)
+ (python-tests-look-at "class SomeClass:")
+ (forward-line)
+ (hs-hide-level 1)
+ (should
+ (string=
+ (python-tests-visible-string)
+ "
+class SomeClass:
+
+ def __init__(self, arg, kwarg=1):
+ def filter(self, nums):
+ def __str__(self):"))))
+ (or enabled (hs-minor-mode -1)))))
+
+(ert-deftest python-hideshow-hide-levels-2 ()
+ "Should hide nested methods and parens at end of defun."
+ (let ((enabled hs-minor-mode))
+ (unwind-protect
+ (progn
+ (python-tests-with-temp-buffer
+ "
+class SomeClass:
+
+ def __init__(self, arg, kwarg=1):
+ self.arg = arg
+ self.kwarg = kwarg
+
+ def filter(self, nums):
+ def fn(item):
+ return item in [self.arg, self.kwarg]
+ return filter(fn, nums)
+
+ def __str__(self):
+ return '%s-%s' % (self.arg, self.kwarg)
+"
+ (hs-minor-mode 1)
+ (python-tests-look-at "def fn(item):")
+ (hs-hide-block)
+ (should
+ (string=
+ (python-tests-visible-string)
+ "
+class SomeClass:
+
+ def __init__(self, arg, kwarg=1):
+ self.arg = arg
+ self.kwarg = kwarg
+
+ def filter(self, nums):
+ def fn(item):
+ return filter(fn, nums)
+
+ def __str__(self):
+ return '%s-%s' % (self.arg, self.kwarg)
+"))))
+ (or enabled (hs-minor-mode -1)))))
+
+
(provide 'python-tests)
--- /dev/null
+;;; sasl-scram-rfc-tests.el --- tests for SCRAM-SHA-1 -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Magnus Henoch <magnus.henoch@gmail.com>
+
+;; 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:
+
+;; Test cases from RFC 5802.
+
+;;; Code:
+
+(require 'sasl)
+(require 'sasl-scram-rfc)
+
+(ert-deftest sasl-scram-sha-1-test ()
+ ;; The following strings are taken from section 5 of RFC 5802.
+ (let ((client
+ (sasl-make-client (sasl-find-mechanism '("SCRAM-SHA-1"))
+ "user"
+ "imap"
+ "localhost"))
+ (data "r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,s=QSXCR+Q6sek8bf92,i=4096")
+ (c-nonce "fyko+d2lbbFgONRv9qkxdawL")
+ (sasl-read-passphrase
+ (lambda (_prompt) (copy-sequence "pencil"))))
+ (sasl-client-set-property client 'c-nonce c-nonce)
+ (should
+ (equal
+ (sasl-scram-sha-1-client-final-message client (vector nil data))
+ "c=biws,r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,p=v0X8v3Bz2T0CJGbJQyF0X+HI4Ts="))
+
+ ;; This should not throw an error:
+ (sasl-scram-sha-1-authenticate-server client (vector nil "v=rmF9pqV8S7suAoZWja4dJRkFsKQ=
+"))))
+
+;;; sasl-scram-rfc-tests.el ends here
;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
-;; Author: Nicolas Petton <petton.nicolas@gmail.com>
+;; Author: Nicolas Petton <nicolas@petton.fr>
;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
(should (equal (seq-concatenate 'vector nil '(8 10)) [8 10]))
(should (equal (seq-concatenate 'vector seq nil) [2 4 6]))))
+(ert-deftest test-seq-mapcat ()
+ (should (equal (seq-mapcat #'seq-reverse '((3 2 1) (6 5 4)))
+ '(1 2 3 4 5 6)))
+ (should (equal (seq-mapcat #'seq-reverse '[(3 2 1) (6 5 4)])
+ '(1 2 3 4 5 6)))
+ (should (equal (seq-mapcat #'seq-reverse '((3 2 1) (6 5 4)) 'vector)
+ '[1 2 3 4 5 6])))
+
+(ert-deftest test-seq-partition ()
+ (should (same-contents-p (seq-partition '(0 1 2 3 4 5 6 7) 3)
+ '((0 1 2) (3 4 5) (6 7))))
+ (should (same-contents-p (seq-partition '[0 1 2 3 4 5 6 7] 3)
+ '([0 1 2] [3 4 5] [6 7])))
+ (should (same-contents-p (seq-partition "Hello world" 2)
+ '("He" "ll" "o " "wo" "rl" "d")))
+ (should (equal (seq-partition '() 2) '()))
+ (should (equal (seq-partition '(1 2 3) -1) '())))
+
+(ert-deftest test-seq-group-by ()
+ (with-test-sequences (seq '(1 2 3 4))
+ (should (equal (seq-group-by #'test-sequences-oddp seq)
+ '((t 1 3) (nil 2 4)))))
+ (should (equal (seq-group-by #'car '((a 1) (b 3) (c 4) (a 2)))
+ '((b (b 3)) (c (c 4)) (a (a 1) (a 2))))))
+
+(ert-deftest test-seq-reverse ()
+ (with-test-sequences (seq '(1 2 3 4))
+ (should (same-contents-p (seq-reverse seq) '(4 3 2 1)))
+ (should (equal (type-of (seq-reverse seq))
+ (type-of seq)))))
+
+(ert-deftest test-seq-into ()
+ (let* ((vector [1 2 3])
+ (list (seq-into vector 'list)))
+ (should (same-contents-p vector list))
+ (should (listp list)))
+ (let* ((list '(hello world))
+ (vector (seq-into list 'vector)))
+ (should (same-contents-p vector list))
+ (should (vectorp vector)))
+ (let* ((string "hello")
+ (list (seq-into string 'list)))
+ (should (same-contents-p string list))
+ (should (stringp string)))
+ (let* ((string "hello")
+ (vector (seq-into string 'vector)))
+ (should (same-contents-p string vector))
+ (should (stringp string)))
+ (let* ((list nil)
+ (vector (seq-into list 'vector)))
+ (should (same-contents-p list vector))
+ (should (vectorp vector))))
+
(provide 'seq-tests)
;;; seq-tests.el ends here
--- /dev/null
+;;; textprop-tests.el --- Test suite for text properties.
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Wolfgang Jenkner <wjenkner@inode.at>
+;; 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/>.
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest textprop-tests-font-lock--remove-face-from-text-property ()
+ "Test `font-lock--remove-face-from-text-property'."
+ (let* ((string "foobar")
+ (stack (list string))
+ (faces '(bold (:foreground "red") underline)))
+ ;; Build each string in `stack' by adding a face to the previous
+ ;; string.
+ (let ((faces (reverse faces)))
+ (push (copy-sequence (car stack)) stack)
+ (put-text-property 0 3 'font-lock-face (pop faces) (car stack))
+ (push (copy-sequence (car stack)) stack)
+ (put-text-property 3 6 'font-lock-face (pop faces) (car stack))
+ (push (copy-sequence (car stack)) stack)
+ (font-lock-prepend-text-property 2 5
+ 'font-lock-face (pop faces) (car stack)))
+ ;; Check that removing the corresponding face from each string
+ ;; yields the previous string in `stack'.
+ (while faces
+ ;; (message "%S" (car stack))
+ (should (equal-including-properties
+ (progn
+ (font-lock--remove-face-from-text-property 0 6
+ 'font-lock-face
+ (pop faces)
+ (car stack))
+ (pop stack))
+ (car stack))))
+ ;; Sanity check.
+ ;; (message "%S" (car stack))
+ (should (and (equal-including-properties (pop stack) string)
+ (null stack)))))
(declare-function tramp-find-executable "tramp-sh")
(declare-function tramp-get-remote-path "tramp-sh")
+(declare-function tramp-get-remote-stat "tramp-sh")
+(declare-function tramp-get-remote-perl "tramp-sh")
(defvar tramp-copy-size-limit)
(defvar tramp-remote-process-environment)
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(with-current-buffer (tramp-get-connection-buffer v)
(message "%s" (buffer-string)))
- (with-current-buffer
- (tramp-get-debug-buffer v)
+ (with-current-buffer (tramp-get-debug-buffer v)
(message "%s" (buffer-string))))))))
(ert-deftest tramp-test00-availability ()
(ert-deftest tramp-test06-directory-file-name ()
"Check `directory-file-name'.
-This checks also `file-name-as-directory', `file-name-directory'
-and `file-name-nondirectory'."
+This checks also `file-name-as-directory', `file-name-directory',
+`file-name-nondirectory' and `unhandled-file-name-directory'."
(should
(string-equal
(directory-file-name "/method:host:/path/to/file")
(should
(string-equal (file-name-nondirectory "/method:host:/path/to/file/") ""))
(should-not
- (file-remote-p
- (unhandled-file-name-directory "/method:host:/path/to/file"))))
+ (unhandled-file-name-directory "/method:host:/path/to/file")))
(ert-deftest tramp-test07-file-exists-p ()
"Check `file-exist-p', `write-region' and `delete-file'."
(should (setq tmp-name2 (file-local-copy tmp-name1)))
(with-temp-buffer
(insert-file-contents tmp-name2)
- (should (string-equal (buffer-string) "foo"))))
+ (should (string-equal (buffer-string) "foo")))
+ ;; Check also that a file transfer with compression works.
+ (let ((default-directory tramp-test-temporary-file-directory)
+ (tramp-copy-size-limit 4)
+ (tramp-inline-compress-start-size 2))
+ (delete-file tmp-name2)
+ (should (setq tmp-name2 (file-local-copy tmp-name1)))))
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2)))))
(progn
(make-directory tmp-name)
(should (file-directory-p tmp-name))
- (should (file-accessible-directory-p tmp-name)))
+ (should (file-accessible-directory-p tmp-name))
+ (should-error
+ (make-directory (expand-file-name "foo/bar" tmp-name))
+ :type 'file-error)
+ (make-directory (expand-file-name "foo/bar" tmp-name) 'parents)
+ (should (file-directory-p (expand-file-name "foo/bar" tmp-name)))
+ (should
+ (file-accessible-directory-p (expand-file-name "foo/bar" tmp-name))))
(ignore-errors (delete-directory tmp-name)))))
(ert-deftest tramp-test14-delete-directory ()
(skip-unless (tramp--test-enabled))
(let* ((tmp-name1 (tramp--test-make-temp-name))
- (tmp-name2 (expand-file-name "foo" tmp-name1)))
+ (tmp-name2 (expand-file-name "foo" tmp-name1))
+ ;; We test for the summary line. Keyword "total" could be localized.
+ (process-environment
+ (append '("LANG=C" "LANGUAGE=C" "LC_ALL=C") process-environment)))
(unwind-protect
(progn
(make-directory tmp-name1)
(concat
;; There might be a summary line.
"\\(total.+[[:digit:]]+\n\\)?"
- ;; We don't know in which order "." and ".." appear.
- "\\(.+ \\.?\\.\n\\)\\{2\\}"
- ".+ foo$")))))
+ ;; We don't know in which order ".", ".." and "foo" appear.
+ "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}")))))
(ignore-errors (delete-directory tmp-name1 'recursive)))))
(ert-deftest tramp-test18-file-attributes ()
This tests also `file-readable-p' and `file-regular-p'."
(skip-unless (tramp--test-enabled))
- (let ((tmp-name (tramp--test-make-temp-name))
+ (let ((tmp-name1 (tramp--test-make-temp-name))
+ (tmp-name2 (tramp--test-make-temp-name))
attr)
(unwind-protect
(progn
- (write-region "foo" nil tmp-name)
- (should (file-exists-p tmp-name))
- (setq attr (file-attributes tmp-name))
+ (write-region "foo" nil tmp-name1)
+ (should (file-exists-p tmp-name1))
+ (setq attr (file-attributes tmp-name1))
(should (consp attr))
- (should (file-exists-p tmp-name))
- (should (file-readable-p tmp-name))
- (should (file-regular-p tmp-name))
+ (should (file-exists-p tmp-name1))
+ (should (file-readable-p tmp-name1))
+ (should (file-regular-p tmp-name1))
;; We do not test inodes and device numbers.
(should (null (car attr)))
(should (numberp (nth 1 attr))) ;; Link.
(should (numberp (nth 7 attr))) ;; Size.
(should (stringp (nth 8 attr))) ;; Modes.
- (setq attr (file-attributes tmp-name 'string))
+ (setq attr (file-attributes tmp-name1 'string))
(should (stringp (nth 2 attr))) ;; Uid.
(should (stringp (nth 3 attr))) ;; Gid.
- (delete-file tmp-name)
- (make-directory tmp-name)
- (should (file-exists-p tmp-name))
- (should (file-readable-p tmp-name))
- (should-not (file-regular-p tmp-name))
- (setq attr (file-attributes tmp-name))
+ (condition-case err
+ (progn
+ (make-symbolic-link tmp-name1 tmp-name2)
+ (should (file-exists-p tmp-name2))
+ (should (file-symlink-p tmp-name2))
+ (setq attr (file-attributes tmp-name2))
+ (should (string-equal
+ (car attr)
+ (file-remote-p (file-truename tmp-name1) 'localname)))
+ (delete-file tmp-name2))
+ (file-error
+ (should (string-equal (error-message-string err)
+ "make-symbolic-link not supported"))))
+ (delete-file tmp-name1)
+
+ (make-directory tmp-name1)
+ (should (file-exists-p tmp-name1))
+ (should (file-readable-p tmp-name1))
+ (should-not (file-regular-p tmp-name1))
+ (setq attr (file-attributes tmp-name1))
(should (eq (car attr) t)))
- (ignore-errors (delete-directory tmp-name)))))
+
+ (ignore-errors (delete-directory tmp-name1)))))
(ert-deftest tramp-test19-directory-files-and-attributes ()
"Check `directory-files-and-attributes'."
(ignore-errors (delete-directory tmp-name1 'recursive)))))
+(defun tramp--test-adb-p ()
+ "Check, whether the remote host runs Android.
+This requires restrictions of file name syntax."
+ (eq (tramp-find-foreign-file-name-handler
+ tramp-test-temporary-file-directory)
+ 'tramp-adb-file-name-handler))
+
(defun tramp--test-smb-or-windows-nt-p ()
"Check, whether the locale or remote host runs MS Windows.
This requires restrictions of file name syntax."
(or (eq system-type 'windows-nt)
(eq (tramp-find-foreign-file-name-handler
tramp-test-temporary-file-directory)
- 'tramp-smb-file-name-handler)))
+ 'tramp-smb-file-name-handler)))
(defun tramp--test-check-files (&rest files)
- "Runs a simple but comprehensive test over every file in FILES."
+ "Run a simple but comprehensive test over every file in FILES."
(let ((tmp-name1 (tramp--test-make-temp-name))
- (tmp-name2 (tramp--test-make-temp-name 'local)))
+ (tmp-name2 (tramp--test-make-temp-name 'local))
+ (files (delq nil files)))
(unwind-protect
(progn
(make-directory tmp-name1)
(make-directory tmp-name2)
- (dolist (elt (delq nil files))
- (let ((file1 (expand-file-name elt tmp-name1))
- (file2 (expand-file-name elt tmp-name2)))
+ (dolist (elt files)
+ (let* ((file1 (expand-file-name elt tmp-name1))
+ (file2 (expand-file-name elt tmp-name2))
+ (file3 (expand-file-name (concat elt "foo") tmp-name1)))
(write-region elt nil file1)
(should (file-exists-p file1))
+
;; Check file contents.
(with-temp-buffer
(insert-file-contents file1)
(should (string-equal (buffer-string) elt)))
+
;; Copy file both directions.
(copy-file file1 tmp-name2)
(should (file-exists-p file2))
(delete-file file1)
(should-not (file-exists-p file1))
(copy-file file2 tmp-name1)
- (should (file-exists-p file1))))
+ (should (file-exists-p file1))
+
+ ;; Method "smb" supports `make-symbolic-link' only if the
+ ;; remote host has CIFS capabilities. tramp-adb.el and
+ ;; tramp-gvfs.el do not support symbolic links at all.
+ (condition-case err
+ (progn
+ (make-symbolic-link file1 file3)
+ (should (file-symlink-p file3))
+ (should
+ (string-equal
+ (expand-file-name file1) (file-truename file3)))
+ (should
+ (string-equal
+ (car (file-attributes file3))
+ (file-remote-p (file-truename file1) 'localname)))
+ ;; Check file contents.
+ (with-temp-buffer
+ (insert-file-contents file3)
+ (should (string-equal (buffer-string) elt)))
+ (delete-file file3))
+ (file-error
+ (should (string-equal (error-message-string err)
+ "make-symbolic-link not supported"))))))
;; Check file names.
(should (equal (directory-files
(should (equal (directory-files
tmp-name1 nil directory-files-no-dot-files-regexp)
(directory-files
- tmp-name2 nil directory-files-no-dot-files-regexp))))
+ tmp-name2 nil directory-files-no-dot-files-regexp)))
+
+ ;; Check directory creation. We use a subdirectory "foo"
+ ;; in order to avoid conflicts with previous file name tests.
+ (dolist (elt files)
+ (let* ((elt1 (concat elt "foo"))
+ (file1 (expand-file-name (concat "foo/" elt) tmp-name1))
+ (file2 (expand-file-name elt file1))
+ (file3 (expand-file-name elt1 file1)))
+ (make-directory file1 'parents)
+ (should (file-directory-p file1))
+ (write-region elt nil file2)
+ (should (file-exists-p file2))
+ (should
+ (equal
+ (directory-files file1 nil directory-files-no-dot-files-regexp)
+ `(,elt)))
+ (should
+ (equal
+ (caar (directory-files-and-attributes
+ file1 nil directory-files-no-dot-files-regexp))
+ elt))
+
+ ;; Check symlink in `directory-files-and-attributes'.
+ (condition-case err
+ (progn
+ (make-symbolic-link file2 file3)
+ (should (file-symlink-p file3))
+ (should
+ (string-equal
+ (caar (directory-files-and-attributes
+ file1 nil (regexp-quote elt1)))
+ elt1))
+ (should
+ (string-equal
+ (cadr (car (directory-files-and-attributes
+ file1 nil (regexp-quote elt1))))
+ (file-remote-p (file-truename file2) 'localname)))
+ (delete-file file3)
+ (should-not (file-exists-p file3)))
+ (file-error
+ (should (string-equal (error-message-string err)
+ "make-symbolic-link not supported"))))
+
+ (delete-file file2)
+ (should-not (file-exists-p file2))
+ (delete-directory file1)
+ (should-not (file-exists-p file1)))))
(ignore-errors (delete-directory tmp-name1 'recursive))
(ignore-errors (delete-directory tmp-name2 'recursive)))))
-;; This test is inspired by Bug#17238.
-(ert-deftest tramp-test30-special-characters ()
- "Check special characters in file names."
- (skip-unless (tramp--test-enabled))
- (skip-unless
- (not
- (memq
- (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
- '(tramp-adb-file-name-handler
- tramp-gvfs-file-name-handler))))
-
- ;; Newlines, slashes and backslashes in file names are not supported.
- ;; So we don't test.
+(defun tramp--test-special-characters ()
+ "Perform the test in `tramp-test30-special-characters*'."
+ ;; Newlines, slashes and backslashes in file names are not
+ ;; supported. So we don't test. And we don't test the tab
+ ;; character on Windows or Cygwin, because the backslash is
+ ;; interpreted as a path separator, preventing "\t" from being
+ ;; expanded to <TAB>.
(tramp--test-check-files
- (if (tramp--test-smb-or-windows-nt-p) "foo bar baz" " foo\tbar baz\t")
+ (if (tramp--test-smb-or-windows-nt-p)
+ "foo bar baz"
+ (if (or (tramp--test-adb-p) (eq system-type 'cygwin))
+ " foo bar baz "
+ " foo\tbar baz\t"))
"$foo$bar$$baz$"
"-foo-bar-baz-"
"%foo%bar%baz%"
"[foo]bar[baz]"
"{foo}bar{baz}"))
-(ert-deftest tramp-test31-utf8 ()
- "Check UTF8 encoding in file names and file contents."
+;; These tests are inspired by Bug#17238.
+(ert-deftest tramp-test30-special-characters ()
+ "Check special characters in file names."
+ (skip-unless (tramp--test-enabled))
+
+ (tramp--test-special-characters))
+
+(ert-deftest tramp-test30-special-characters-with-stat ()
+ "Check special characters in file names.
+Use the `stat' command."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless
+ (eq
+ (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ 'tramp-sh-file-name-handler))
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (skip-unless (tramp-get-remote-stat v)))
+
+ (unwind-protect
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "perl" nil)
+ (tramp--test-special-characters))
+ ;; Reset suppressed properties.
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "perl" 'undef))))
+
+(ert-deftest tramp-test30-special-characters-with-perl ()
+ "Check special characters in file names.
+Use the `perl' command."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless
+ (eq
+ (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ 'tramp-sh-file-name-handler))
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (skip-unless (tramp-get-remote-perl v)))
+
+ (unwind-protect
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "stat" nil)
+ (tramp--test-special-characters))
+ ;; Reset suppressed properties.
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "stat" 'undef))))
+
+(ert-deftest tramp-test30-special-characters-with-ls ()
+ "Check special characters in file names.
+Use the `ls' command."
(skip-unless (tramp--test-enabled))
+ (skip-unless
+ (eq
+ (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ 'tramp-sh-file-name-handler))
+ (unwind-protect
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "stat" nil)
+ (tramp-set-connection-property v "perl" nil)
+ (tramp--test-special-characters))
+ ;; Reset suppressed properties.
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "stat" 'undef)
+ (tramp-set-connection-property v "perl" 'undef))))
+
+(defun tramp--test-utf8 ()
+ "Perform the test in `tramp-test31-utf8*'."
(let ((coding-system-for-read 'utf-8)
(coding-system-for-write 'utf-8)
(file-name-coding-system 'utf-8))
(tramp--test-check-files
+ "Γυρίστε το Γαλαξία με Ώτο Στοπ"
"أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت"
"银河系漫游指南系列"
"Автостопом по гала́ктике")))
+(ert-deftest tramp-test31-utf8 ()
+ "Check UTF8 encoding in file names and file contents."
+ (skip-unless (tramp--test-enabled))
+
+ (tramp--test-utf8))
+
+(ert-deftest tramp-test31-utf8-with-stat ()
+ "Check UTF8 encoding in file names and file contents.
+Use the `stat' command."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless
+ (eq
+ (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ 'tramp-sh-file-name-handler))
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (skip-unless (tramp-get-remote-stat v)))
+
+ (unwind-protect
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "perl" nil)
+ (tramp--test-utf8))
+ ;; Reset suppressed properties.
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "perl" 'undef))))
+
+(ert-deftest tramp-test31-utf8-with-perl ()
+ "Check UTF8 encoding in file names and file contents.
+Use the `perl' command."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless
+ (eq
+ (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ 'tramp-sh-file-name-handler))
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (skip-unless (tramp-get-remote-perl v)))
+
+ (unwind-protect
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "stat" nil)
+ (tramp--test-utf8))
+ ;; Reset suppressed properties.
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "stat" 'undef))))
+
+(ert-deftest tramp-test31-utf8-with-ls ()
+ "Check UTF8 encoding in file names and file contents.
+Use the `ls' command."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless
+ (eq
+ (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory)
+ 'tramp-sh-file-name-handler))
+
+ (unwind-protect
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "stat" nil)
+ (tramp-set-connection-property v "perl" nil)
+ (tramp--test-utf8))
+ ;; Reset suppressed properties.
+ (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
+ (tramp-set-connection-property v "stat" 'undef)
+ (tramp-set-connection-property v "perl" 'undef))))
+
;; This test is inspired by Bug#16928.
(ert-deftest tramp-test32-asynchronous-requests ()
"Check parallel asynchronous requests.
(not (string-match "^tramp--?test" (symbol-name x)))
(not (string-match "unload-hook$" (symbol-name x)))
(ert-fail (format "`%s' still bound" x)))))
-; (progn (message "`%s' still bound" x)))))
;; There shouldn't be left a hook function containing a Tramp
;; function. We do not regard the Tramp unload hooks.
(mapatoms
;; doesn't work well when an interactive password must be provided.
;; * Fix `tramp-test27-start-file-process' for `nc' and on MS
;; Windows (`process-send-eof'?).
-;; * Fix `tramp-test30-special-characters' for `adb' and `nc'.
+;; * Fix `tramp-test30-special-characters' for `nc'.
;; * Fix `tramp-test31-utf8' for `nc'/`telnet' (when target is a dumb
;; busybox). Seems to be in `directory-files'.
;; * Fix Bug#16928. Set expected error of `tramp-test32-asynchronous-requests'.
;; BACKEND PROPERTIES
;;
-;; * revision-granularity
+;; * revision-granularity DONE
;; STATE-QUERYING FUNCTIONS
;;
-;; * registered (file)
-;; * state (file)
+;; * registered (file) DONE
+;; * state (file) DONE
;; - dir-status (dir update-function)
;; - dir-status-files (dir files default-state update-function)
;; - dir-extra-headers (dir)
;; - dir-printer (fileinfo)
;; - status-fileinfo-extra (file)
-;; * working-revision (file)
+;; * working-revision (file) DONE
;; - latest-on-branch-p (file)
-;; * checkout-model (files)
+;; * checkout-model (files) DONE
;; - mode-line-string (file)
;; STATE-CHANGING FUNCTIONS
;;
-;; * create-repo (backend)
-;; * register (files &optional comment)
+;; * create-repo (backend) DONE
+;; * register (files &optional comment) DONE
;; - responsible-p (file)
;; - receive-file (file rev)
-;; - unregister (file)
+;; - unregister (file) DONE
;; * checkin (files comment)
;; * find-revision (file rev buffer)
;; * checkout (file &optional rev)
;; Check the revision granularity.
(should (memq (vc-test--revision-granularity-function backend)
- '(file repository)))
+ '(file repository)))
;; Create empty repository.
(make-directory default-directory)
(should (file-directory-p default-directory))
- (vc-test--create-repo-function backend))
+ (vc-test--create-repo-function backend)
+ (should (eq (vc-responsible-backend default-directory) backend)))
;; Save exit.
(ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
(write-region "bla" nil tmp-name2 nil 'nomessage)
(should (file-exists-p tmp-name2))
(should-not (vc-registered tmp-name2))
- (vc-register
- (list backend (list tmp-name1 tmp-name2)))
+ (vc-register (list backend (list tmp-name1 tmp-name2)))
(should (file-exists-p tmp-name1))
(should (vc-registered tmp-name1))
(should (file-exists-p tmp-name2))
(vc-test--unregister-function backend tmp-name2)
(should-not (vc-registered tmp-name2)))
;; CVS, SVN, SCCS, SRC and Mtn are not supported.
- (vc-not-supported (message "%s" (error-message-string err))))
+ (vc-not-supported t))
+ ;; The files shall still exist.
(should (file-exists-p tmp-name1))
(should (file-exists-p tmp-name2))))
;; Save exit.
(ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
-;; `vc-state' returns different results for different backends. So we
-;; don't check with `should', but print the results for analysis.
(defun vc-test--state (backend)
"Check the different states of a file."
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
- vc-test--cleanup-hook errors)
+ vc-test--cleanup-hook)
(unwind-protect
(progn
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
- ;; Create empty repository.
+ ;; Create empty repository. Check repository state.
(make-directory default-directory)
(vc-test--create-repo-function backend)
- (message "%s" (vc-state default-directory backend))
- ;(should (eq (vc-state default-directory backend) 'up-to-date))
+ ;; nil: Hg Mtn RCS
+ ;; added: Git
+ ;; unregistered: CVS SCCS SRC
+ ;; up-to-date: Bzr SVN
+ (should (eq (vc-state default-directory)
+ (vc-state default-directory backend)))
+ (should (memq (vc-state default-directory)
+ '(nil added unregistered up-to-date)))
(let ((tmp-name (expand-file-name "foo" default-directory)))
- ;; Check for initial state.
- (message "%s" (vc-state tmp-name backend))
- ;(should (eq (vc-state tmp-name backend) 'unregistered))
+ ;; Check state of an empty file.
- ;; Write a new file. Check for state.
+ ;; nil: Hg Mtn SRC SVN
+ ;; added: Git
+ ;; unregistered: RCS SCCS
+ ;; up-to-date: Bzr CVS
+ (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
+ (should (memq (vc-state tmp-name)
+ '(nil added unregistered up-to-date)))
+
+ ;; Write a new file. Check state.
(write-region "foo" nil tmp-name nil 'nomessage)
- (message "%s" (vc-state tmp-name backend))
- ;(should (eq (vc-state tmp-name backend) 'unregistered))
- ;; Register a file. Check for state.
+ ;; nil: Mtn
+ ;; added: Git
+ ;; unregistered: Hg RCS SCCS SRC SVN
+ ;; up-to-date: Bzr CVS
+ (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
+ (should (memq (vc-state tmp-name)
+ '(nil added unregistered up-to-date)))
+
+ ;; Register a file. Check state.
(vc-register
(list backend (list (file-name-nondirectory tmp-name))))
- (message "%s" (vc-state tmp-name backend))
- ;(should (eq (vc-state tmp-name backend) 'added))
- ;; Unregister the file. Check for state.
+ ;; added: Git Mtn
+ ;; unregistered: Hg RCS SCCS SRC SVN
+ ;; up-to-date: Bzr CVS
+ (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
+ (should (memq (vc-state tmp-name) '(added unregistered up-to-date)))
+
+ ;; Unregister the file. Check state.
(condition-case nil
(progn
(vc-test--unregister-function backend tmp-name)
- (message "%s" (vc-state tmp-name backend))
- );(should (eq (vc-state tmp-name backend) 'unregistered)))
- (vc-not-supported (message "%s" 'unsupported)))))
+
+ ;; added: Git
+ ;; unregistered: Hg
+ ;; unsupported: CVS Mtn SCCS SRC SVN
+ ;; up-to-date: Bzr
+ (should (eq (vc-state tmp-name) (vc-state tmp-name backend)))
+ (should (memq (vc-state tmp-name)
+ '(added unregistered up-to-date))))
+ (vc-not-supported t))))
;; Save exit.
(ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
(file-name-as-directory
(expand-file-name
(make-temp-name "vc-test") temporary-file-directory)))
- vc-test--cleanup-hook errors)
+ vc-test--cleanup-hook)
(unwind-protect
(progn
'vc-test--cleanup-hook
`(lambda () (delete-directory ,default-directory 'recursive)))
- ;; Create empty repository.
+ ;; Create empty repository. Check working revision of
+ ;; repository, should be nil.
(make-directory default-directory)
(vc-test--create-repo-function backend)
+ ;; nil: CVS Mtn RCS SCCS
+ ;; "0": Bzr Hg SRC SVN
+ ;; "master": Git
+ (should (eq (vc-working-revision default-directory)
+ (vc-working-revision default-directory backend)))
(should
(member
- (vc-working-revision default-directory backend) '("0" "master")))
+ (vc-working-revision default-directory) '(nil "0" "master")))
(let ((tmp-name (expand-file-name "foo" default-directory)))
- ;; Check for initial state.
+ ;; Check initial working revision, should be nil until
+ ;; it's registered.
+
+ ;; nil: CVS Mtn RCS SCCS SVN
+ ;; "0": Bzr Hg SRC
+ ;; "master": Git
+ (should (eq (vc-working-revision tmp-name)
+ (vc-working-revision tmp-name backend)))
(should
- (member (vc-working-revision tmp-name backend) '("0" "master")))
+ (member (vc-working-revision tmp-name) '(nil "0" "master")))
- ;; Write a new file. Check for state.
+ ;; Write a new file. Check working revision.
(write-region "foo" nil tmp-name nil 'nomessage)
+
+ ;; nil: CVS Mtn RCS SCCS SVN
+ ;; "0": Bzr Hg SRC
+ ;; "master": Git
+ (should (eq (vc-working-revision tmp-name)
+ (vc-working-revision tmp-name backend)))
(should
- (member (vc-working-revision tmp-name backend) '("0" "master")))
+ (member (vc-working-revision tmp-name) '(nil "0" "master")))
- ;; Register a file. Check for state.
+ ;; Register a file. Check working revision.
(vc-register
(list backend (list (file-name-nondirectory tmp-name))))
+
+ ;; nil: Mtn RCS SCCS
+ ;; "0": Bzr CVS Hg SRC SVN
+ ;; "master": Git
+ (should (eq (vc-working-revision tmp-name)
+ (vc-working-revision tmp-name backend)))
(should
- (member (vc-working-revision tmp-name backend) '("0" "master")))
+ (member (vc-working-revision tmp-name) '(nil "0" "master")))
- ;; Unregister the file. Check for working-revision.
+ ;; Unregister the file. Check working revision.
(condition-case nil
(progn
(vc-test--unregister-function backend tmp-name)
+
+ ;; nil: RCS
+ ;; "0": Bzr Hg
+ ;; "master": Git
+ ;; unsupported: CVS Mtn SCCS SRC SVN
+ (should (eq (vc-working-revision tmp-name)
+ (vc-working-revision tmp-name backend)))
(should
(member
- (vc-working-revision tmp-name backend) '("0" "master"))))
- (vc-not-supported (message "%s" 'unsupported)))))
+ (vc-working-revision tmp-name) '(nil "0" "master"))))
+ (vc-not-supported t))))
+
+ ;; Save exit.
+ (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
+
+(defun vc-test--checkout-model (backend)
+ "Check the checkout model of a repository."
+
+ (let ((vc-handled-backends `(,backend))
+ (default-directory
+ (file-name-as-directory
+ (expand-file-name
+ (make-temp-name "vc-test") temporary-file-directory)))
+ vc-test--cleanup-hook)
+
+ (unwind-protect
+ (progn
+ ;; Cleanup.
+ (add-hook
+ 'vc-test--cleanup-hook
+ `(lambda () (delete-directory ,default-directory 'recursive)))
+
+ ;; Create empty repository. Check repository checkout model.
+ (make-directory default-directory)
+ (vc-test--create-repo-function backend)
+
+ ;; Surprisingly, none of the backends returns 'announce.
+ ;; nil: RCS
+ ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
+ ;; locking: SCCS
+ (should (memq (vc-checkout-model backend default-directory)
+ '(announce implicit locking)))
+
+ (let ((tmp-name (expand-file-name "foo" default-directory)))
+ ;; Check checkout model of an empty file.
+
+ ;; nil: RCS
+ ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
+ ;; locking: SCCS
+ (should (memq (vc-checkout-model backend tmp-name)
+ '(announce implicit locking)))
+
+ ;; Write a new file. Check checkout model.
+ (write-region "foo" nil tmp-name nil 'nomessage)
+
+ ;; nil: RCS
+ ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
+ ;; locking: SCCS
+ (should (memq (vc-checkout-model backend tmp-name)
+ '(announce implicit locking)))
+
+ ;; Register a file. Check checkout model.
+ (vc-register
+ (list backend (list (file-name-nondirectory tmp-name))))
+
+ ;; nil: RCS
+ ;; implicit: Bzr CVS Git Hg Mtn SRC SVN
+ ;; locking: SCCS
+ (should (memq (vc-checkout-model backend tmp-name)
+ '(announce implicit locking)))
+
+ ;; Unregister the file. Check checkout model.
+ (condition-case nil
+ (progn
+ (vc-test--unregister-function backend tmp-name)
+
+ ;; nil: RCS
+ ;; implicit: Bzr Git Hg
+ ;; unsupported: CVS Mtn SCCS SRC SVN
+ (should (memq (vc-checkout-model backend tmp-name)
+ '(announce implicit locking))))
+ (vc-not-supported t))))
;; Save exit.
(ignore-errors (run-hooks 'vc-test--cleanup-hook)))))
(defun vc-test--mtn-enabled ()
(executable-find vc-mtn-program))
+;; Obsoleted.
(defvar vc-arch-program)
(defun vc-test--arch-enabled ()
(executable-find vc-arch-program))
-
;; There are too many failed test cases yet. We suppress them on hydra.
(if (getenv "NIX_STORE")
(ert-deftest vc-test ()
(ert-deftest
,(intern (format "vc-test-%s00-create-repo" backend-string)) ()
- ,(format "Check `vc-create-repo' for the %s backend." backend-string)
+ ,(format "Check `vc-create-repo' for the %s backend."
+ backend-string)
(vc-test--create-repo ',backend))
(ert-deftest
(ert-deftest
,(intern (format "vc-test-%s03-working-revision" backend-string)) ()
- ,(format "Check `vc-working-revision' for the %s backend." backend-string)
+ ,(format "Check `vc-working-revision' for the %s backend."
+ backend-string)
+ (skip-unless
+ (ert-test-passed-p
+ (ert-test-most-recent-result
+ (ert-get-test
+ ',(intern
+ (format "vc-test-%s01-register" backend-string))))))
+ (vc-test--working-revision ',backend))
+
+ (ert-deftest
+ ,(intern (format "vc-test-%s04-checkout-model" backend-string)) ()
+ ,(format "Check `vc-checkout-model' for the %s backend."
+ backend-string)
(skip-unless
(ert-test-passed-p
(ert-test-most-recent-result
(ert-get-test
',(intern
(format "vc-test-%s01-register" backend-string))))))
- (vc-test--working-revision ',backend)))))))
+ (vc-test--checkout-model ',backend)))))))
(provide 'vc-tests)
;;; vc-tests.el ends here
+++ /dev/null
-;; -*- lexical-binding: t; -*-
-
-(require 'cl)
-(require 'xwidget)
-(require 'xwidget-test)
-(require 'parallel)
-
-(defvar xwidget-parallel-config (list :emacs-path (expand-file-name
- "~/packages/xwidget-build/src/emacs")))
-
-(defmacro xwidget-deftest (name types &rest body)
- (declare (indent defun))
- (if (null types)
- `(ert-deftest ,(intern (format "%s" name)) ()
- (let ((parallel-config xwidget-parallel-config))
- ,@body))
- `(progn
- ,@(loop for type in types
- collect
- `(ert-deftest ,(intern (format "%s-%s" name type)) ()
- (let ((parallel-config xwidget-parallel-config)
- (type ',type)
- (title ,(symbol-name type)))
- ,@body))))))
-
-(xwidget-deftest xwidget-make-xwidget (Button ToggleButton slider socket cairo)
- (let* ((beg 1)
- (end 1)
- (width 100)
- (height 100)
- (data nil)
- (proc (parallel-start
- (lambda (beg end type title width height data)
- (require 'xwidget)
- (require 'cl)
- (with-temp-buffer
- (insert ?\0)
- (let* ((buffer (current-buffer))
- (xwidget (make-xwidget beg end type title width height data buffer)))
- (set-xwidget-query-on-exit-flag xwidget nil)
- (parallel-remote-send (coerce (xwidget-info xwidget) 'list))
- (parallel-remote-send (buffer-name buffer))
- (buffer-name (xwidget-buffer xwidget)))))
- :env (list beg end type title width height data)))
- (results (parallel-get-results proc)))
- (should (parallel-success-p proc))
- (when (parallel-success-p proc)
- (destructuring-bind (xwidget-buffer temp-buffer xwidget-info)
- results
- (should (equal (list type title width height)
- xwidget-info))
- (should (equal temp-buffer xwidget-buffer))))))
-
-(xwidget-deftest xwidget-query-on-exit-flag ()
- (should (equal '(nil t)
- (parallel-get-results
- (parallel-start (lambda ()
- (require 'xwidget)
- (let ((xwidget (make-xwidget 1 1 'Button "Button" 100 100 nil)))
- (parallel-remote-send (xwidget-query-on-exit-flag xwidget))
- (set-xwidget-query-on-exit-flag xwidget nil)
- (xwidget-query-on-exit-flag xwidget))))))))
-
-(xwidget-deftest xwidget-query-on-exit-flag (Button ToggleButton slider socket cairo)
- (should (parallel-get-result
- (parallel-start (lambda (type title)
- (require 'xwidget)
- (with-temp-buffer
- (let ((xwidget (make-xwidget 1 1 type title 10 10 nil)))
- (set-xwidget-query-on-exit-flag xwidget nil)
- (xwidgetp xwidget))))
- :env (list type title)))))
-
-(xwidget-deftest xwidget-CHECK_XWIDGET ()
- (should (equal (parallel-get-result
- (parallel-start (lambda ()
- (require 'xwidget)
- (xwidget-info nil))))
- '(wrong-type-argument xwidgetp nil)))
- (should (equal (parallel-get-result
- (parallel-start (lambda ()
- (require 'xwidget)
- (xwidget-view-info nil))))
- '(wrong-type-argument xwidget-view-p nil))))
-
-(xwidget-deftest xwidget-view-p (Button ToggleButton slider socket cairo)
- (should (parallel-get-result
- (parallel-start (lambda (type title)
- (require 'xwidget)
- (with-temp-buffer
- (insert ?\0)
- (let* ((xwidget (xwidget-insert 1 type title 100 100))
- (window (xwidget-display xwidget)))
- (set-xwidget-query-on-exit-flag xwidget nil)
- (xwidget-view-p
- (xwidget-view-lookup xwidget window)))))
- :env (list type title)
- :graphical t
- :emacs-args '("-T" "emacs-debug")))))
-
-(defun xwidget-interactive-tests ()
- "Interactively test Button ToggleButton and slider.
-
-Start Emacs instances and try to insert the xwidget."
- (interactive)
- (flet ((test-xwidget (type)
- (parallel-get-result
- (parallel-start (lambda ()
- (require 'xwidget)
- (with-temp-buffer
- (insert ?\0)
- (set-xwidget-query-on-exit-flag
- (xwidget-insert 1 type (format "%s" type) 100 100) nil)
- (display-buffer (current-buffer))
- (cons type (or (y-or-n-p (format "Do you see a %s?" type)) 'failed))))
- :graphical t
- :debug t
- :config xwidget-parallel-config))))
- (message "%S" (mapcar #'test-xwidget '(Button ToggleButton slider)))))
-
-(provide 'xwidget-tests)
(not (semantic-tag-of-class-p fcn-in 'function)))
(error "No tag of class 'function to insert comment for"))
- (let ((lextok (semantic-documentation-comment-preceeding-tag fcn-in 'lex))
+ (let ((lextok (semantic-documentation-comment-preceding-tag fcn-in 'lex))
)
(when (not lextok)
RM=rm
-EMACS=emacs
+EMACS=../../src/emacs
+
+all: clean $(addsuffix .test,$(wildcard *.*))
clean:
- -$(RM) *.test
+ -$(RM) -f *.new
# TODO:
# - mark the places where the indentation is known to be incorrect,
# and allow either ignoring those errors or not.
%.test: %
- -$(RM) $<.new
$(EMACS) --batch $< \
--eval '(indent-region (point-min) (point-max) nil)' \
--eval '(write-region (point-min) (point-max) "$<.new")'
--- /dev/null
+var foo = function() {
+ return 7;
+};
+
+var foo = function() {
+ return 7;
+ },
+ bar = 8;
+
+var foo = function() {
+ return 7;
+ },
+ bar = function() {
+ return 8;
+ };
+
+// Local Variables:
+// indent-tabs-mode: nil
+// js-indent-level: 2
+// js-indent-first-init: dynamic
+// End:
+
+// The following test intentionally produces a scan error and should
+// be placed below all other tests to prevent awkward indentation.
+// (It still thinks it's within the body of a function.)
+
+var foo = function() {
+ return 7;
+ ,
+ bar = 8;
--- /dev/null
+var foo = function() {
+ return 7;
+ };
+
+var foo = function() {
+ return 7;
+ },
+ bar = 8;
+
+var foo = function() {
+ return 7;
+ },
+ bar = function() {
+ return 8;
+ };
+
+// Local Variables:
+// indent-tabs-mode: nil
+// js-indent-level: 2
+// js-indent-first-init: t
+// End:
function test ()
{
- return /[/]/.test ('/') // (bug#19397)
+ return /[/]/.test ('/') // (bug#19397)
}
var f = bar('/protocols/')
a++
b +=
c
+
+baz(`http://foo.bar/${tee}`)
+ .qux();
+
+`multiline string
+ contents
+ are kept
+ unchanged!`
+
+// Local Variables:
+// indent-tabs-mode: nil
+// js-indent-level: 2
+// End:
/foo/xi != %r{bar}mo.tee
+foo { /"tee/
+ bar { |qux| /'fee"/ } # bug#20026
+}
+
bar(class: XXX) do # ruby-indent-keyword-label
foo
end
--- /dev/null
+<element attribute="value"></element>
+
+<element
+ attribute="value">
+ <element
+ attribute="value">
+ </element>
+</element>
+
+<!--
+ Local Variables:
+ sgml-attribute-offset: 2
+ End:
+ -->
+++ /dev/null
-;;test like:
-;; cd /path/to/xwidgets-emacs-dir
-;; make all&& src/emacs -q --eval "(progn (load \"`pwd`/lisp/xwidget-test.el\") (xwidget-demo-basic))"
-
-
-;; you should see:
-;; - a gtk button
-;; - a gtk toggle button
-;; - a gtk slider button
-;; - an xembed window(using gtk_socket) showing another emacs instance
-;; - an xembed window(using gtk_socket) showing an uzbl web browser if its installed
-
-;;the widgets will move when you type in the buffer. good!
-
-;;there will be redrawing issues when widgets change rows, etc. bad!
-
-;;its currently difficult to give kbd focus to the xembedded emacs,
-;;but try evaling the following:
-
-;; (xwidget-set-keyboard-grab 3 1)
-
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; demo/test functions
-(require 'xwidget)
-
-(defmacro xwidget-demo (name &rest body)
- `(defun ,(intern (concat "xwidget-demo-" name)) ()
- (interactive)
- (switch-to-buffer ,(format "*xwidget-demo-%s*" name))
- (text-mode);;otherwise no local keymap
- (insert "Some random text for xwidgets to be inserted in for demo purposes.\n")
- ,@body))
-
-(xwidget-demo "a-button"
- (xwidget-insert (point-min) 'Button "button" 60 50)
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
-
-(xwidget-demo "a-button-bidi"
- (xwidget-insert (+ 5 (point-min)) 'Button "button" 60 50)
- (set (make-local-variable 'bidi-paragraph-direction) 'right-to-left)
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
-
-
-(xwidget-demo "a-toggle-button"
- (xwidget-insert (point-min) 'ToggleButton "toggle" 60 50)
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
-
-(xwidget-demo "a-big-button"
- (xwidget-insert (point-min) 'Button "button" 400 500)
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
-
-(xwidget-demo "a-socket"
- (xwidget-insert (point-min) 'socket "socket" 500 500)
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
-
-(xwidget-demo "a-socket-osr-broken"
- (xwidget-insert (point-min) 'socket-osr "socket-osr" 500 500)
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
-
-
-(xwidget-demo "a-slider"
- (xwidget-insert (point-min) 'slider "slider" 500 100)
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
-
-(xwidget-demo "a-canvas"
- (xwidget-insert (point-min) 'cairo "canvas" 1000 1000)
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
-
-(xwidget-demo "a-webkit-broken"
- (xwidget-insert (point-min) 'webkit "webkit" 1000 1000)
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
-
-(xwidget-demo "a-webkit-osr"
- (xwidget-insert (point-min) 'webkit-osr "webkit-osr" 1000 1000)
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic)
- (xwidget-webkit-goto-uri (xwidget-at 1) "http://www.fsf.org"))
-
-(xwidget-demo "a-xwgir"
- (xwidget-insert (point-min) 'xwgir "xwgir" 1000 1000)
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
-
-(xwidget-demo "a-xwgir-color-button"
- (xwgir-require-namespace "Gtk" "3.0")
- (put 'ColorButton :xwgir-class '("Gtk" "ColorSelection"))
- (xwidget-insert (point-min) 'ColorButton "xwgir-color-button" 1000 1000)
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
-
-(xwidget-demo "a-xwgir-button"
- (xwgir-require-namespace "Gtk" "3.0")
- (put 'xwgirButton :xwgir-class '("Gtk" "Button"))
-
- (xwidget-insert (point-min) 'xwgirButton "xwgir label didnt work..." 700 700)
- (xwgir-xwidget-call-method (xwidget-at 1) "set_label" '( "xwgir label worked!"))
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
-
-(xwidget-demo "a-xwgir-check-button"
- (xwgir-require-namespace "Gtk" "3.0")
- (put 'xwgirCheckButton :xwgir-class '("Gtk" "CheckButton"))
-
- (xwidget-insert (point-min) 'xwgirCheckButton "xwgir label didnt work..." 700 700)
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
-
-(xwidget-demo "a-xwgir-hscale"
- (xwgir-require-namespace "Gtk" "3.0")
- (put 'xwgirHScale :xwgir-class '("Gtk" "HScale"))
-
- (xwidget-insert (point-min) 'xwgirHScale "xwgir label didnt work..." 700 700)
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
-
-(xwidget-demo "a-xwgir-webkit"
- (xwgir-require-namespace "WebKit" "3.0")
- (put 'xwgirWebkit :xwgir-class '("WebKit" "WebView"))
-
- (xwidget-insert (point-min) 'xwgirWebkit "xwgir webkit..." 700 700)
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic))
-
-
-
-;; tentative testcase:
-;; (xwgir-require-namespace "WebKit" "3.0")
-
-;; (put 'webkit-osr :xwgir-class '("WebKit" "WebView"))
-;; (xwgir-call-method (xwidget-at 1) "set_zoom_level" '(3.0))
-
-;; (xwgir-require-namespace "Gtk" "3.0")
-;; (put 'color-selection :xwgir-class '("Gtk" "ColorSelection"))
-
-
-(xwidget-demo "basic"
- (xwidget-insert (point-min) 'button "button" 40 50 )
- (xwidget-insert 15 'toggle "toggle" 60 30 )
- (xwidget-insert 30 'socket "emacs" 400 200 )
- (xwidget-insert 20 'slider "slider" 100 50 )
- (xwidget-insert 40 'socket "uzbl-core" 400 400 )
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-basic)
-)
-
-
-;it doesnt seem gtk_socket_steal works very well. its deprecated.
-; xwininfo -int
-; then (xwidget-embed-steal 3 <winid>)
-(defun xwidget-demo-grab ()
- (interactive)
- (insert "0 <<< grabbed appp will appear here\n")
- (xwidget-insert 1 1 3 "1" 1000 )
- (define-key (current-local-map) [xwidget-event] 'xwidget-handler-demo-grab)
- )
-
-;ive basically found these xembeddable things:
-;openvrml
-;emacs
-;mplayer
-;surf
-;uzbl
-
-;try the openvrml:
-;/usr/libexec/openvrml-xembed 0 ~/Desktop/HelloWorld.wrl
-
-(defun xwidget-handler-demo-basic ()
- (interactive)
- (message "stuff happened to xwidget %S" last-input-event)
- (let*
- ((xwidget-event-type (nth 1 last-input-event))
- (xwidget (nth 2 last-input-event)))
- (cond ( (eq xwidget-event-type 'xembed-ready)
- (let*
- ((xembed-id (nth 3 last-input-event)))
- (message "xembed ready event: %S xw-id:%s" xembed-id xwidget)
- ;;will start emacs/uzbl in a xembed socket when its ready
- (cond
- (t;;(eq 3 xwidget)
- (start-process "xembed" "*xembed*" "/var/lib/jenkins/jobs/emacs-xwidgets-automerge/workspace/src/emacs" "-q" "--parent-id" (number-to-string xembed-id) ) )
-;; ((eq 5 xwidget-id)
-;; (start-process "xembed2" "*xembed2*" "uzbl-core" "-s" (number-to-string xembed-id) "http://www.fsf.org" )
- )
-
- )
- ))))
-
-
-
-(defun xwidget-handler-demo-grab ()
- (interactive)
- (message "stuff happened to xwidget %S" last-input-event)
- (let*
- ((xwidget-event-type (nth 2 last-input-event)))
- (cond ( (eq xwidget-event-type 'xembed-ready)
- (let*
- ((xembed-id (nth 3 last-input-event)))
- (message "xembed ready %S" xembed-id)
- )
- ))))
-(defun xwidget-dummy-hook ()
- (message "xwidget dummy hook called"))
-
-; (xwidget-resize-hack 1 200 200)
-
-;(xwidget-demo-basic)
-
-(provide 'xwidget-test-manual)