commit 325bf192ae281046834884b12705d6c522871b24 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Sat Jun 6 18:37:45 2015 -0700 Merge from gnulib This incorporates: 2015-06-06 acl-permissions: pacify -Wsuggest-attribute=const 2015-06-05 stdio: Don't redefine gets when using C++ 2015-06-05 acl-permissions: port to AIX, C89 HP-UX 2015-06-02 file-has-acl: fix build on Mac OS X 10 2015-06-01 gnulib-tool: concatenate lib_SOURCES to a single line 2015-06-01 pthread_sigmask: discount system version if a simple macro 2015-05-31 readlinkat: avoid OS X 10.10 trailing slash bug * doc/misc/texinfo.tex, lib/acl-internal.h, lib/get-permissions.c: * lib/readlinkat.c, lib/set-permissions.c, lib/stdio.in.h: * m4/acl.m4, m4/pthread_sigmask.m4, m4/readlinkat.m4: Copy from gnulib. * lib/gnulib.mk: Regenerate. diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 4b48564..1a4741d 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2015-05-26.15} +\def\texinfoversion{2015-06-01.15} % % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -304,6 +304,7 @@ % Avoid "undefined control sequence" errors. \def\lastchapterdefs{} \def\lastsectiondefs{} +\def\lastsection{} \def\prevchapterdefs{} \def\prevsectiondefs{} \def\lastcolordefs{} @@ -7607,7 +7608,7 @@ end \long\def\nillm@{\nil@}% % This macro is expanded during the Texinfo macro expansion, not during its -% definition. It gets all the arguments values and assigns them to macros +% definition. It gets all the arguments' values and assigns them to macros % macarg.ARGNAME % % #1 is the macro name diff --git a/lib/acl-internal.h b/lib/acl-internal.h index 11fdea1..d592a75 100644 --- a/lib/acl-internal.h +++ b/lib/acl-internal.h @@ -289,6 +289,10 @@ struct permission_context { int get_permissions (const char *, int, mode_t, struct permission_context *); int set_permissions (struct permission_context *, const char *, int); -void free_permission_context (struct permission_context *); +void free_permission_context (struct permission_context *) +#if ! (defined USE_ACL && (HAVE_ACL_GET_FILE || defined GETACL)) + _GL_ATTRIBUTE_CONST +#endif + ; _GL_INLINE_HEADER_END diff --git a/lib/get-permissions.c b/lib/get-permissions.c index ccee1f1..6c6618d 100644 --- a/lib/get-permissions.c +++ b/lib/get-permissions.c @@ -33,7 +33,7 @@ int get_permissions (const char *name, int desc, mode_t mode, struct permission_context *ctx) { - memset (ctx, 0, sizeof(*ctx)); + memset (ctx, 0, sizeof *ctx); ctx->mode = mode; #if USE_ACL && HAVE_ACL_GET_FILE @@ -215,38 +215,40 @@ get_permissions (const char *name, int desc, mode_t mode, #elif USE_ACL && HAVE_GETACL /* HP-UX */ - int ret; - - if (desc != -1) - ret = fgetacl (desc, NACLENTRIES, ctx->entries); - else - ret = getacl (name, NACLENTRIES, ctx->entries); - if (ret < 0) - { - if (errno == ENOSYS || errno == EOPNOTSUPP || errno == ENOTSUP) - ret = 0; - else - return -1; - } - else if (ret > NACLENTRIES) - /* If NACLENTRIES cannot be trusted, use dynamic memory allocation. */ - abort (); - ctx->count = ret; + { + int ret; + + if (desc != -1) + ret = fgetacl (desc, NACLENTRIES, ctx->entries); + else + ret = getacl (name, NACLENTRIES, ctx->entries); + if (ret < 0) + { + if (errno == ENOSYS || errno == EOPNOTSUPP || errno == ENOTSUP) + ret = 0; + else + return -1; + } + else if (ret > NACLENTRIES) + /* If NACLENTRIES cannot be trusted, use dynamic memory allocation. */ + abort (); + ctx->count = ret; # if HAVE_ACLV_H - ret = acl ((char *) name, ACL_GET, NACLVENTRIES, ctx->aclv_entries); - if (ret < 0) - { - if (errno == ENOSYS || errno == EOPNOTSUPP || errno == EINVAL) - ret = 0; - else - return -2; - } - else if (ret > NACLVENTRIES) - /* If NACLVENTRIES cannot be trusted, use dynamic memory allocation. */ + ret = acl ((char *) name, ACL_GET, NACLVENTRIES, ctx->aclv_entries); + if (ret < 0) + { + if (errno == ENOSYS || errno == EOPNOTSUPP || errno == EINVAL) + ret = 0; + else + return -2; + } + else if (ret > NACLVENTRIES) + /* If NACLVENTRIES cannot be trusted, use dynamic memory allocation. */ abort (); - ctx->aclv_count = ret; + ctx->aclv_count = ret; # endif + } #elif USE_ACL && HAVE_ACLX_GET && ACL_AIX_WIP /* AIX */ @@ -254,24 +256,27 @@ get_permissions (const char *name, int desc, mode_t mode, #elif USE_ACL && HAVE_STATACL /* older AIX */ - if (desc != -1) - ret = fstatacl (desc, STX_NORMAL, &ctx->u.a, sizeof (ctx->u)); - else - ret = statacl (name, STX_NORMAL, &ctx->u.a, sizeof (ctx->u)); - if (ret == 0) - ctx->have_u = true; + { + int ret; + if (desc != -1) + ret = fstatacl (desc, STX_NORMAL, &ctx->u.a, sizeof ctx->u); + else + ret = statacl ((char *) name, STX_NORMAL, &ctx->u.a, sizeof ctx->u); + if (ret == 0) + ctx->have_u = true; + } #elif USE_ACL && HAVE_ACLSORT /* NonStop Kernel */ - int ret; - - ret = acl ((char *) name, ACL_GET, NACLENTRIES, ctx->entries); - if (ret < 0) - return -1; - else if (ret > NACLENTRIES) - /* If NACLENTRIES cannot be trusted, use dynamic memory allocation. */ - abort (); - ctx->count = ret; + { + int ret = acl ((char *) name, ACL_GET, NACLENTRIES, ctx->entries); + if (ret < 0) + return -1; + else if (ret > NACLENTRIES) + /* If NACLENTRIES cannot be trusted, use dynamic memory allocation. */ + abort (); + ctx->count = ret; + } #endif diff --git a/lib/gnulib.mk b/lib/gnulib.mk index 95f2f8b..2dd0ef8 100644 --- a/lib/gnulib.mk +++ b/lib/gnulib.mk @@ -44,8 +44,7 @@ HAVE_INCLUDE_NEXT = (__GNUC__ || 60000000 <= __DECC_VER) ## begin gnulib module acl-permissions -libgnu_a_SOURCES += acl-errno-valid.c acl-internal.c \ - get-permissions.c set-permissions.c +libgnu_a_SOURCES += acl-errno-valid.c acl-internal.c get-permissions.c set-permissions.c EXTRA_DIST += acl-internal.h acl.h acl_entries.c diff --git a/lib/readlinkat.c b/lib/readlinkat.c index f4826f9..c91cf0e 100644 --- a/lib/readlinkat.c +++ b/lib/readlinkat.c @@ -18,7 +18,10 @@ #include +#include #include +#include +#include #if HAVE_READLINKAT @@ -27,6 +30,21 @@ ssize_t rpl_readlinkat (int fd, char const *file, char *buf, size_t len) { +# if READLINK_TRAILING_SLASH_BUG + size_t file_len = strlen (file); + if (file_len && file[file_len - 1] == '/') + { + /* Even if FILE without the slash is a symlink to a directory, + both lstat() and stat() must resolve the trailing slash to + the directory rather than the symlink. We can therefore + safely use stat() to distinguish between EINVAL and + ENOTDIR/ENOENT, avoiding extra overhead of rpl_lstat(). */ + struct stat st; + if (stat (file, &st) == 0) + errno = EINVAL; + return -1; + } +# endif /* READLINK_TRAILING_SLASH_BUG */ return readlinkat (fd, file, buf, len); } diff --git a/lib/set-permissions.c b/lib/set-permissions.c index ba291f3..2236879 100644 --- a/lib/set-permissions.c +++ b/lib/set-permissions.c @@ -699,7 +699,7 @@ set_acls (struct permission_context *ctx, const char *name, int desc, if (desc != -1) ret = fchacl (desc, &ctx->u.a, ctx->u.a.acl_len); else - ret = chacl (name, &ctx->u.a, ctx->u.a.acl_len); + ret = chacl ((char *) name, &ctx->u.a, ctx->u.a.acl_len); if (ret < 0) { if (errno == ENOSYS && from_mode) diff --git a/lib/stdio.in.h b/lib/stdio.in.h index 759c94d..ec43874 100644 --- a/lib/stdio.in.h +++ b/lib/stdio.in.h @@ -723,11 +723,10 @@ _GL_WARN_ON_USE (getline, "getline is unportable - " so any use of gets warrants an unconditional warning; besides, C11 removed it. */ #undef gets -#if HAVE_RAW_DECL_GETS +#if HAVE_RAW_DECL_GETS && !defined __cplusplus _GL_WARN_ON_USE (gets, "gets is a security hole - use fgets instead"); #endif - #if @GNULIB_OBSTACK_PRINTF@ || @GNULIB_OBSTACK_PRINTF_POSIX@ struct obstack; /* Grow an obstack with formatted output. Return the number of diff --git a/m4/acl.m4 b/m4/acl.m4 index 5da6a43..75fc9ce 100644 --- a/m4/acl.m4 +++ b/m4/acl.m4 @@ -1,5 +1,5 @@ # acl.m4 - check for access control list (ACL) primitives -# serial 20 +# serial 21 # Copyright (C) 2002, 2004-2015 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation @@ -181,12 +181,26 @@ AC_DEFUN([gl_FILE_HAS_ACL], [ AC_REQUIRE([gl_FUNC_ACL_ARG]) if test "$enable_acl" != no; then - AC_CHECK_HEADERS([linux/xattr.h]) - AC_CHECK_HEADERS([sys/xattr.h], - [AC_CHECK_FUNCS([getxattr])]) + AC_CACHE_CHECK([for getxattr with XATTR_NAME_POSIX_ACL macros], + [gl_cv_getxattr_with_posix_acls], + [gl_cv_getxattr_with_posix_acls=no + AC_LINK_IFELSE( + [AC_LANG_PROGRAM( + [[#include + #include + #include + ]], + [[ssize_t a = getxattr (".", XATTR_NAME_POSIX_ACL_ACCESS, 0, 0); + ssize_t b = getxattr (".", XATTR_NAME_POSIX_ACL_DEFAULT, 0, 0); + return a < 0 || b < 0; + ]])], + [gl_cv_getxattr_with_posix_acls=yes])]) fi - if test "$ac_cv_header_sys_xattr_h,$ac_cv_func_getxattr" = yes,yes; then + if test "$gl_cv_getxattr_with_posix_acls" = yes; then LIB_HAS_ACL= + AC_DEFINE([GETXATTR_WITH_POSIX_ACLS], 1, + [Define to 1 if getxattr works with XATTR_NAME_POSIX_ACL_ACCESS + and XATTR_NAME_POSIX_ACL_DEFAULT.]) else dnl Set gl_need_lib_has_acl to a nonempty value, so that any dnl later gl_FUNC_ACL call will set LIB_HAS_ACL=$LIB_ACL. diff --git a/m4/pthread_sigmask.m4 b/m4/pthread_sigmask.m4 index 5c17dfc..2598856 100644 --- a/m4/pthread_sigmask.m4 +++ b/m4/pthread_sigmask.m4 @@ -1,4 +1,4 @@ -# pthread_sigmask.m4 serial 15 +# pthread_sigmask.m4 serial 16 dnl Copyright (C) 2011-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, @@ -40,6 +40,30 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK], LIBS="$gl_save_LIBS" ]) if test $gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD = yes; then + AC_CACHE_CHECK([whether pthread_sigmask is only a macro], + [gl_cv_func_pthread_sigmask_is_macro], + [gl_save_LIBS="$LIBS" + LIBS="$LIBS $LIBMULTITHREAD" + AC_LINK_IFELSE( + [AC_LANG_PROGRAM( + [[#include + #include + #undef pthread_sigmask + ]], + [[return pthread_sigmask (0, (sigset_t *) 0, (sigset_t *) 0);]]) + ], + [gl_cv_func_pthread_sigmask_is_macro=no], + [gl_cv_func_pthread_sigmask_is_macro=yes]) + LIBS="$gl_save_LIBS" + ]) + if test $gl_cv_func_pthread_sigmask_is_macro = yes; then + dnl On MinGW pthread_sigmask is just a macro which always returns 0. + dnl It does not exist as a real function, which is required by POSIX. + REPLACE_PTHREAD_SIGMASK=1 + gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD=no + fi + fi + if test $gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD = yes; then dnl pthread_sigmask is available with -pthread or -lpthread. LIB_PTHREAD_SIGMASK="$LIBMULTITHREAD" else diff --git a/m4/readlinkat.m4 b/m4/readlinkat.m4 index d0f5e69..3477602 100644 --- a/m4/readlinkat.m4 +++ b/m4/readlinkat.m4 @@ -1,4 +1,4 @@ -# serial 4 +# serial 5 # See if we need to provide readlinkat replacement. dnl Copyright (C) 2009-2015 Free Software Foundation, Inc. @@ -13,6 +13,7 @@ AC_DEFUN([gl_FUNC_READLINKAT], AC_REQUIRE([gl_UNISTD_H_DEFAULTS]) AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) AC_CHECK_FUNCS_ONCE([readlinkat]) + AC_REQUIRE([gl_FUNC_READLINK]) if test $ac_cv_func_readlinkat = no; then HAVE_READLINKAT=0 else @@ -25,8 +26,17 @@ AC_DEFUN([gl_FUNC_READLINKAT], ssize_t readlinkat (int, char const *, char *, size_t);]])], [gl_cv_decl_readlinkat_works=yes], [gl_cv_decl_readlinkat_works=no])]) - if test "$gl_cv_decl_readlink_works" != yes; then - REPLACE_READLINKAT=1 - fi + # Assume readinkat has the same trailing slash bug as readlink, + # as is the case on Mac Os X 10.10 + case "$gl_cv_func_readlink_works" in + *yes) + if test "$gl_cv_decl_readlinkat_works" != yes; then + REPLACE_READLINKAT=1 + fi + ;; + *) + REPLACE_READLINKAT=1 + ;; + esac fi ]) commit 6fec047e9470731d588e52f516c1c704a7a55411 Author: Juri Linkov Date: Sun Jun 7 01:02:38 2015 +0300 * lisp/progmodes/grep.el (zrgrep): Let-bind grep-highlight-matches before calling grep-compute-defaults because now it affects the command lines computed in grep-compute-defaults. (Bug#20728) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 68852f7..cc6662f 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -1077,6 +1077,9 @@ file name to `*.gz', and sets `grep-highlight-matches' to `always'." (grep-find-template nil) (grep-find-command nil) (grep-host-defaults-alist nil) + ;; Set `grep-highlight-matches' to `always' + ;; since `zgrep' puts filters in the grep output. + (grep-highlight-matches 'always) ;; Use for `grep-read-files' (grep-files-aliases '(("all" . "* .*") ("gz" . "*.gz")))) @@ -1094,10 +1097,7 @@ file name to `*.gz', and sets `grep-highlight-matches' to `always'." nil default-directory t)) (confirm (equal current-prefix-arg '(4)))) (list regexp files dir confirm grep-find-template))))))) - ;; Set `grep-highlight-matches' to `always' - ;; since `zgrep' puts filters in the grep output. - (let ((grep-find-template template) - (grep-highlight-matches 'always)) + (let ((grep-find-template template)) (rgrep regexp files dir confirm))) ;;;###autoload commit 809885c2173d212e54570f1da7e5e8a4f45a9f62 Author: Glenn Morris Date: Sat Jun 6 12:12:06 2015 -0700 Address some compilation warnings. * lisp/international/mule-cmds.el (w32-get-console-codepage) (w32-get-console-output-codepage): * lisp/progmodes/elisp-mode.el (xref-collect-references): * lisp/version.el (cairo-version-string): Declare. * lisp/erc/erc.el (erc-nickname-in-use): Fix typo. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index a860951..88732cb 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4185,7 +4185,7 @@ See also `erc-display-error-notice'." ;; server's setting if we haven't ;; established a connection yet (- 9 (length erc-nick-uniquifier)))) - erc-nick-uniqifier))) + erc-nick-uniquifier))) (erc-cmd-NICK newnick) (erc-display-error-notice nil diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 474806d..7643668 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2519,6 +2519,9 @@ is returned. Thus, for instance, if charset \"ISO8859-2\", ;; too, for setting things such as calendar holidays, ps-print paper ;; size, spelling dictionary. +(declare-function w32-get-console-codepage "w32proc.c" ()) +(declare-function w32-get-console-output-codepage "w32proc.c" ()) + (defun locale-translate (locale) "Expand LOCALE according to `locale-translation-file-name', if possible. For example, translate \"swedish\" into \"sv_SE.ISO8859-1\"." diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 61709c3..e12d133 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -582,6 +582,7 @@ It can be quoted, or be inside a quoted form." (declare-function xref-make-bogus-location "xref" (message)) (declare-function xref-make "xref" (description location)) (declare-function xref-collect-matches "xref" (input dir &optional kind)) +(declare-function xref-collect-references "xref" (symbol dir)) (defun elisp-xref-find (action id) (require 'find-func) diff --git a/lisp/version.el b/lisp/version.el index b8555cb..7b636f3 100644 --- a/lisp/version.el +++ b/lisp/version.el @@ -47,6 +47,7 @@ This variable first existed in version 19.23.") (defvar motif-version-string) (defvar gtk-version-string) (defvar ns-version-string) +(defvar cairo-version-string) (defun emacs-version (&optional here) "Return string describing the version of Emacs that is running. commit f1baa156503f089d6627171e0e9ad73bbdbb7268 Merge: 6f10a3f 957cbfd Author: Eli Zaretskii Date: Sat Jun 6 15:55:15 2015 +0300 Fix display when a font claims large values of ascent and descent This fixes bug#20628. * src/xdisp.c (get_phys_cursor_geometry): Correct the Y coordinate of a hollow cursor glyph when the original glyph's ascent is too small. (get_font_ascent_descent, normal_char_ascent_descent) (normal_char_height): New functions. (handle_single_display_spec, append_space_for_newline) (calc_pixel_width_or_height, produce_stretch_glyph) (calc_line_height_property): Use normal_char_ascent_descent and normal_char_height. (x_produce_glyphs): When font-global values of ascent and descent are too large, use per-character glyph metrics instead, if possible. But don't allow the glyph row's ascent and descent values become smaller than the values from the metrics of the font's "normal" character. * src/xftfont.c (xftfont_draw): * src/w32font.c (w32font_draw): Correct the values of ascent and descent used to draw glyphless characters' hex code in a box. * src/xterm.c (x_draw_glyph_string_background): * src/xdisp.c (x_produce_glyphs): * src/w32term.c (x_draw_glyph_string_background): * src/nsterm.m (ns_maybe_dumpglyphs_background): Use FONT_TOO_HIGH to detect fonts whose global ascent and descent values are too large to be used in layout decision, and redraw the background when that happens. * src/dispextern.h (FONT_TOO_HIGH): New macro. (get_font_ascent_descent): Add prototype. * src/xterm.c (x_new_font): * src/w32term.c (x_new_font): * src/nsterm.m (x_new_font): * src/font.c (font_open_entity): * src/composite.c (composition_gstring_width): Use get_font_ascent_descent to obtain reasonable values for ascent and descent of a font. commit 6f10a3f90fb94506031712140246f1a5dbee71eb Author: Nicolas Richard Date: Sat Jun 6 10:05:07 2015 +0200 Add assertion in adjust_point_for_property * src/keyboard.c (adjust_point_for_property): Add eassert for current buffer being shown in selected window. diff --git a/src/keyboard.c b/src/keyboard.c index bedd10b..23f7ce7 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1687,6 +1687,8 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified) bool check_composition = ! modified, check_display = 1, check_invisible = 1; ptrdiff_t orig_pt = PT; + eassert (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer); + /* FIXME: cycling is probably not necessary because these properties can't be usefully combined anyway. */ while (check_composition || check_display || check_invisible) commit 73e6f36ed672edc827621b85dc88b8521030633d Author: Dmitry Gutov Date: Sat Jun 6 12:57:59 2015 +0300 Replace uses of in-string-p; make it obsolete * lisp/thingatpt.el (in-string-p): Declare obsolete (bug#20732). (end-of-sexp, beginning-of-sexp): Use syntax-ppss instead. diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index b3fe1bc..7fdb32c 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -180,6 +180,7 @@ The bounds of THING are determined by `bounds-of-thing-at-point'." (defun in-string-p () "Return non-nil if point is in a string. \[This is an internal function.]" + (declare (obsolete "use (nth 3 (syntax-ppss)) instead." "25.1")) (let ((orig (point))) (save-excursion (beginning-of-defun) @@ -190,7 +191,7 @@ The bounds of THING are determined by `bounds-of-thing-at-point'." \[This is an internal function.]" (let ((char-syntax (syntax-after (point)))) (if (or (eq char-syntax ?\)) - (and (eq char-syntax ?\") (in-string-p))) + (and (eq char-syntax ?\") (nth 3 (syntax-ppss)))) (forward-char 1) (forward-sexp 1)))) @@ -201,7 +202,7 @@ The bounds of THING are determined by `bounds-of-thing-at-point'." \[This is an internal function.]" (let ((char-syntax (char-syntax (char-before)))) (if (or (eq char-syntax ?\() - (and (eq char-syntax ?\") (in-string-p))) + (and (eq char-syntax ?\") (nth 3 (syntax-ppss)))) (forward-char -1) (forward-sexp -1)))) commit e5108ff1e4ac0c17361a703e565fda78112812db Author: Eli Zaretskii Date: Sat Jun 6 12:52:56 2015 +0300 Fix Dired display of an explicit list of files by ls-lisp.el * lisp/ls-lisp.el (ls-lisp-uid-d-fmt, ls-lisp-uid-s-fmt) (ls-lisp-gid-d-fmt, ls-lisp-gid-s-fmt): Make the initial values be correct for when displaying individual files separately, not as part of listing a directory, in which case these values are not recomputed by 'ls-lisp-insert-directory', but used verbatim. diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 0ddae24..d4b8905 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -237,13 +237,13 @@ to fail to line up, e.g. if month names are not all of the same length." :type 'boolean :group 'ls-lisp) -(defvar ls-lisp-uid-d-fmt "-%d" +(defvar ls-lisp-uid-d-fmt " %d" "Format to display integer UIDs.") -(defvar ls-lisp-uid-s-fmt "-%s" +(defvar ls-lisp-uid-s-fmt " %s" "Format to display user names.") -(defvar ls-lisp-gid-d-fmt "-%d" +(defvar ls-lisp-gid-d-fmt " %d" "Format to display integer GIDs.") -(defvar ls-lisp-gid-s-fmt "-%s" +(defvar ls-lisp-gid-s-fmt " %s" "Format to display user group names.") (defvar ls-lisp-filesize-d-fmt "%d" "Format to display integer file sizes.") commit 6cdeb62ea6f8613cb16ae046407250eed9cbaf88 Author: Eli Zaretskii Date: Sat Jun 6 12:33:59 2015 +0300 * lisp/dired.el (dired): Doc fix. (Bug#20739) diff --git a/lisp/dired.el b/lisp/dired.el index e523b94..02946e0 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -749,10 +749,16 @@ as an argument to `dired-goto-file'." "\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it. Optional second argument SWITCHES specifies the `ls' options used. \(Interactively, use a prefix argument to be able to specify SWITCHES.) -Dired displays a list of files in DIRNAME (which may also have -shell wildcards appended to select certain files). If DIRNAME is a cons, -its first element is taken as the directory name and the rest as an explicit -list of files to make directory entries for. + +If DIRNAME is a string, Dired displays a list of files in DIRNAME (which +may also have shell wildcards appended to select certain files). + +If DIRNAME is a cons, its first element is taken as the directory name +and the rest as an explicit list of files to make directory entries for. +In this case, SWITCHES are applied to each of the files separately, and +therefore switches that control the order of the files in the produced +listing have no effect. + \\\ You can flag files for deletion with \\[dired-flag-file-deletion] and then delete them by typing \\[dired-do-flagged-delete]. commit d31cd490744b3fe43f6394c5973ebe48350f0eff Author: Nicolas Richard Date: Fri Jun 5 18:57:26 2015 +0200 Do not adjust point in a non-selected window * src/keyboard.c (command_loop_1): Do not adjust point when current buffer is not shown in selected window (Bug#20590). diff --git a/src/keyboard.c b/src/keyboard.c index ca589dd..bedd10b 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1618,6 +1618,7 @@ command_loop_1 (void) finalize: if (current_buffer == prev_buffer + && XBUFFER (XWINDOW (selected_window)->contents) == current_buffer && last_point_position != PT && NILP (Vdisable_point_adjustment) && NILP (Vglobal_disable_point_adjustment)) commit bb2c6d2eb51a7efc200691181ea7b6f17f8f383c Author: Nicolas Richard Date: Fri Jun 5 18:54:33 2015 +0200 * etc/DEBUG: Mention 'maybe_call_debugger' diff --git a/etc/DEBUG b/etc/DEBUG index 51a3736..cc39e42 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -54,8 +54,9 @@ kick in, provided that you run under GDB. ** Getting control to the debugger -`Fsignal' is a very useful place to put a breakpoint in. -All Lisp errors go through there. +`Fsignal' is a very useful place to put a breakpoint in. All Lisp +errors go through there. If you are only interested in errors that +would fire the debugger, breaking at `maybe_call_debugger' is useful. It is useful, when debugging, to have a guaranteed way to return to the debugger at any time. When using X, this is easy: type C-z at the commit b0c0b96ee3525f65554e61d1c74b8325fe9f53cd Author: Nicolas Petton Date: Sat Jun 6 01:54:51 2015 +0200 Fix a unit test for map.el * test/automated/map-tests.el (test-map-let): Fix the test to work with the new syntax of `map-let'. diff --git a/test/automated/map-tests.el b/test/automated/map-tests.el index 96fc9b1..abda03d 100644 --- a/test/automated/map-tests.el +++ b/test/automated/map-tests.el @@ -322,9 +322,9 @@ Evaluate BODY for each created map. (should (= foo 1)) (should (= bar 2)) (should (null baz))) - (map-let ((foo . a) - (bar . b) - (baz . c)) '((foo . 1) (bar . 2)) + (map-let (('foo a) + ('bar b) + ('baz c)) '((foo . 1) (bar . 2)) (should (= a 1)) (should (= b 2)) (should (null c)))) commit 30e518379e1033ca2f37f8c82b38c4647f7dd424 Author: Nicolas Petton Date: Sat Jun 6 01:54:11 2015 +0200 * lisp/emacs-lisp/map.el (map-let): Better docstring. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index a0792d9..85f6bca 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -47,20 +47,25 @@ (pcase-defmacro map (&rest args) "pcase pattern matching map elements. Matches if the object is a map (list, hash-table or array), and -binds values from ARGS to the corresponding element of the map. +binds values from ARGS to their corresponding elements of the map. -ARGS can be a list elements of the form (KEY . PAT) or elements -of the form SYMBOL, which stands for (SYMBOL . SYMBOL)." +ARGS can be a list elements of the form (KEY PAT) or elements +of the form SYMBOL, which stands for ('SYMBOL SYMBOL)." `(and (pred map-p) ,@(map--make-pcase-bindings args))) -(defmacro map-let (args map &rest body) - "Bind the variables in ARGS to the elements of MAP then evaluate BODY. +(defmacro map-let (keys map &rest body) + "Bind the variables in KEYS to the elements of MAP then evaluate BODY. -ARGS can be an alist of key/binding pairs or a list of keys. MAP -can be a list, hash-table or array." +KEYS can be a list of symbols, in which case each element will be +bound to the looked up value in MAP. + +KEYS can also be a list of (KEY VARNAME) pairs, in which case +KEY is not quoted. + +MAP can be a list, hash-table or array." (declare (indent 2) (debug t)) - `(pcase-let ((,(map--make-pcase-patterns args) ,map)) + `(pcase-let ((,(map--make-pcase-patterns keys) ,map)) ,@body)) (defmacro map--dispatch (spec &rest args) commit 2a54e8dfff722014d6d709ccfe53230e551b9c22 Author: Nicolas Petton Date: Sat Jun 6 01:50:32 2015 +0200 Better syntax for the map pcase pattern * lisp/emacs-lisp/map.el: Improves the map pcase pattern to take bindings of the form (KEY PAT) or SYMBOL. KEY is not quoted. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index b332cf4..a0792d9 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -360,7 +360,7 @@ If KEY is not found, return DEFAULT which defaults to nil." "Return a list of pcase bindings from ARGS to the elements of a map." (seq-map (lambda (elt) (if (consp elt) - `(app (pcase--flip map-elt ',(car elt)) ,(cdr elt)) + `(app (pcase--flip map-elt ,(car elt)) ,(cadr elt)) `(app (pcase--flip map-elt ',elt) ,elt))) args)) commit cd22663b8521f2cc34b260fc097e189428535b29 Author: Nicolas Petton Date: Sat Jun 6 01:25:04 2015 +0200 * lisp/emacs-lisp/map.el (map--dispatch): Better docstring. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index b59ad63..b332cf4 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -64,13 +64,13 @@ can be a list, hash-table or array." ,@body)) (defmacro map--dispatch (spec &rest args) - "Evaluate one of the provided forms depending on the type of MAP. + "Evaluate one of the forms specified by ARGS based on the type of MAP. SPEC can be a map or a list of the form (VAR MAP [RESULT]). ARGS should have the form [TYPE FORM]... The following keyword types are meaningful: `:list', -`:hash-table' and `array'. +`:hash-table' and `:array'. An error is thrown if MAP is neither a list, hash-table nor array. commit 431fca48a82514d140bf2e4ee93c344661723eac Author: Nicolas Petton Date: Sat Jun 6 01:09:40 2015 +0200 ; * lisp/emacs-lisp/map.el: Fix formatting. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 897743e..b59ad63 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -91,7 +91,7 @@ form. ((arrayp ,map-var) ,(plist-get args :array)) (t (error "Unsupported map: %s" ,map-var)))) ,@(when (cddr spec) - `((setq ,result-var ,@(cddr spec)))) + `((setq ,result-var ,@(cddr spec)))) ,result-var))) (defun map-elt (map key &optional default) @@ -309,12 +309,12 @@ MAP can be a list, hash-table or array." (defun map--apply-array (function map) "Private function used to apply FUNCTION over MAP, MAP being an array." - (let ((index 0)) - (seq-map (lambda (elt) - (prog1 - (funcall function index elt) - (setq index (1+ index)))) - map))) + (let ((index 0)) + (seq-map (lambda (elt) + (prog1 + (funcall function index elt) + (setq index (1+ index)))) + map))) (defun map--elt-list (map key &optional default) "Lookup, in the list MAP, the value associated with KEY and return it. commit 8fe836abbd64a8445880184083e1a92f87ef938a Author: Nicolas Petton Date: Sat Jun 6 01:08:00 2015 +0200 Fix a byte-compiler error in map-put and map-delete * lisp/emacs-lisp/map.el (map-put, map-delete): Ensure that `setq' is called with a symbol. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index b10be44..897743e 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -113,11 +113,14 @@ with VALUE. MAP can be a list, hash-table or array." (declare (debug t)) - `(progn - (map--dispatch (m ,map m) - :list (setq ,map (cons (cons ,key ,value) m)) - :hash-table (puthash ,key ,value m) - :array (aset m ,key ,value)))) + (let ((symbol (symbolp map))) + `(progn + (map--dispatch (m ,map m) + :list (if ,symbol + (setq ,map (cons (cons ,key ,value) m)) + (error "Literal lists are not allowed, %s must be a symbol" ',map)) + :hash-table (puthash ,key ,value m) + :array (aset m ,key ,value))))) (defmacro map-delete (map key) "In MAP, delete the key KEY if present and return MAP. @@ -125,11 +128,14 @@ If MAP is an array, store nil at the index KEY. MAP can be a list, hash-table or array." (declare (debug t)) - `(progn - (map--dispatch (m ,map m) - :list (setq ,map (map--delete-alist m ,key)) - :hash-table (remhash ,key m) - :array (map--delete-array m ,key)))) + (let ((symbol (symbolp map))) + `(progn + (map--dispatch (m ,map m) + :list (if ,symbol + (setq ,map (map--delete-alist m ,key)) + (error "Literal lists are not allowed, %s must be a symbol" ',map)) + :hash-table (remhash ,key m) + :array (map--delete-array m ,key))))) (defun map-nested-elt (map keys &optional default) "Traverse MAP using KEYS and return the looked up value or DEFAULT if nil. commit 5977a07d949a60b66d0f2310fbd4dbd06cd0b9ea Author: Glenn Morris Date: Fri Jun 5 18:10:07 2015 -0400 * admin/gitmerge.el (gitmerge-commit-message): Revert to including "skipped" messages in ChangeLog once again. diff --git a/admin/gitmerge.el b/admin/gitmerge.el index c6a3446..70dff29 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -314,7 +314,7 @@ Returns non-nil if conflicts remain." SKIP denotes whether those commits are actually skipped. If END is nil, only the single commit BEG is merged." (with-temp-buffer - (insert (if skip "; " "") + (insert ; (if skip "; " "") ; I have no idea what to do for this "Merge from " branch "\n\n" (if skip (concat "The following commit" commit 9533ed8d05c347b513f8680ecde8d4120114b2b9 Author: Tassilo Horn Date: Fri Jun 5 23:58:39 2015 +0200 Use string> instead of equiv lambda with string< * lisp/help.el (view-emacs-news): Use string> instead of equivalent lambda with string<. diff --git a/lisp/help.el b/lisp/help.el index 1411c1a..fd5cbc6 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -360,7 +360,7 @@ With argument, display info only for the selected version." (cons "NEWS" (directory-files data-directory nil "^NEWS\\.[0-9][-0-9]*$" nil))) - (sort (delete-dups res) (lambda (a b) (string< b a))))) + (sort (delete-dups res) #'string>))) (current (car all-versions))) (setq version (completing-read (format "Read NEWS for the version (default %s): " current) commit b0eb66823f12c85d04e36ddd0e58e20c0a0694db Author: Glenn Morris Date: Fri Jun 5 16:30:39 2015 -0400 * lisp/emacs-lisp/map.el (map--dispatch): Move before use. (map--delete-array): Fix typo. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 46c7958..b10be44 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -63,6 +63,37 @@ can be a list, hash-table or array." `(pcase-let ((,(map--make-pcase-patterns args) ,map)) ,@body)) +(defmacro map--dispatch (spec &rest args) + "Evaluate one of the provided forms depending on the type of MAP. + +SPEC can be a map or a list of the form (VAR MAP [RESULT]). +ARGS should have the form [TYPE FORM]... + +The following keyword types are meaningful: `:list', +`:hash-table' and `array'. + +An error is thrown if MAP is neither a list, hash-table nor array. + +Return RESULT if non-nil or the result of evaluation of the +form. + +\(fn (VAR MAP [RESULT]) &rest ARGS)" + (declare (debug t) (indent 1)) + (unless (listp spec) + (setq spec `(,spec ,spec))) + (let ((map-var (car spec)) + (result-var (make-symbol "result"))) + `(let ((,map-var ,(cadr spec)) + ,result-var) + (setq ,result-var + (cond ((listp ,map-var) ,(plist-get args :list)) + ((hash-table-p ,map-var) ,(plist-get args :hash-table)) + ((arrayp ,map-var) ,(plist-get args :array)) + (t (error "Unsupported map: %s" ,map-var)))) + ,@(when (cddr spec) + `((setq ,result-var ,@(cddr spec)))) + ,result-var))) + (defun map-elt (map key &optional default) "Perform a lookup in MAP of KEY and return its associated value. If KEY is not found, return DEFAULT which defaults to nil. @@ -254,37 +285,6 @@ MAP can be a list, hash-table or array." (`hash-table (map--into-hash-table map)) (t (error "Not a map type name: %S" type)))) -(defmacro map--dispatch (spec &rest args) - "Evaluate one of the provided forms depending on the type of MAP. - -SPEC can be a map or a list of the form (VAR MAP [RESULT]). -ARGS should have the form [TYPE FORM]... - -The following keyword types are meaningful: `:list', -`:hash-table' and `array'. - -An error is thrown if MAP is neither a list, hash-table nor array. - -Return RESULT if non-nil or the result of evaluation of the -form. - -\(fn (VAR MAP [RESULT]) &rest ARGS)" - (declare (debug t) (indent 1)) - (unless (listp spec) - (setq spec `(,spec ,spec))) - (let ((map-var (car spec)) - (result-var (make-symbol "result"))) - `(let ((,map-var ,(cadr spec)) - ,result-var) - (setq ,result-var - (cond ((listp ,map-var) ,(plist-get args :list)) - ((hash-table-p ,map-var) ,(plist-get args :hash-table)) - ((arrayp ,map-var) ,(plist-get args :array)) - (t (error "Unsupported map: %s" ,map-var)))) - ,@(when (cddr spec) - `((setq ,result-var ,@(cddr spec)))) - ,result-var))) - (defun map--apply-alist (function map) "Private function used to apply FUNCTION over MAP, MAP being an alist." (seq-map (lambda (pair) @@ -338,7 +338,7 @@ If KEY is not found, return DEFAULT which defaults to nil." (let ((len (seq-length map))) (and (>= key 0) (<= key len) - (aset m key nil))) + (aset map key nil))) map) (defun map--into-hash-table (map) commit 45fbcfe37da8e0caa941311626db77e94889fddb Author: Glenn Morris Date: Fri Jun 5 16:29:41 2015 -0400 * test/automated/map-tests.el: Replace "assert" with "should". diff --git a/test/automated/map-tests.el b/test/automated/map-tests.el index 2f7d4eb..96fc9b1 100644 --- a/test/automated/map-tests.el +++ b/test/automated/map-tests.el @@ -56,18 +56,18 @@ Evaluate BODY for each created map. (ert-deftest test-map-elt () (with-maps-do map - (assert (= 3 (map-elt map 0))) - (assert (= 4 (map-elt map 1))) - (assert (= 5 (map-elt map 2))) - (assert (null (map-elt map -1))) - (assert (null (map-elt map 4))))) + (should (= 3 (map-elt map 0))) + (should (= 4 (map-elt map 1))) + (should (= 5 (map-elt map 2))) + (should (null (map-elt map -1))) + (should (null (map-elt map 4))))) (ert-deftest test-map-elt-default () (with-maps-do map - (assert (= 5 (map-elt map 7 5))))) + (should (= 5 (map-elt map 7 5))))) (ert-deftest test-map-elt-with-nil-value () - (assert (null (map-elt '((a . 1) + (should (null (map-elt '((a . 1) (b)) 'b '2)))) @@ -75,89 +75,89 @@ Evaluate BODY for each created map. (ert-deftest test-map-put () (with-maps-do map (map-put map 2 'hello) - (assert (eq (map-elt map 2) 'hello))) + (should (eq (map-elt map 2) 'hello))) (let ((ht (make-hash-table))) (map-put ht 2 'a) - (assert (eq (map-elt ht 2) + (should (eq (map-elt ht 2) 'a))) (let ((alist '((0 . a) (1 . b) (2 . c)))) (map-put alist 2 'a) - (assert (eq (map-elt alist 2) + (should (eq (map-elt alist 2) 'a))) (let ((vec [3 4 5])) (should-error (map-put vec 3 6)))) (ert-deftest test-map-put-literal () - (assert (= (map-elt (map-put [1 2 3] 1 4) 1) + (should (= (map-elt (map-put [1 2 3] 1 4) 1) 4)) - (assert (= (map-elt (map-put (make-hash-table) 'a 2) 'a) + (should (= (map-elt (map-put (make-hash-table) 'a 2) 'a) 2)) (should-error (map-put '((a . 1)) 'b 2)) (should-error (map-put '() 'a 1))) (ert-deftest test-map-put-return-value () (let ((ht (make-hash-table))) - (assert (eq (map-put ht 'a 'hello) ht)))) + (should (eq (map-put ht 'a 'hello) ht)))) (ert-deftest test-map-delete () (with-maps-do map (map-delete map 1) - (assert (null (map-elt map 1)))) + (should (null (map-elt map 1)))) (with-maps-do map (map-delete map -2) - (assert (null (map-elt map -2))))) + (should (null (map-elt map -2))))) (ert-deftest test-map-delete-return-value () (let ((ht (make-hash-table))) - (assert (eq (map-delete ht 'a) ht)))) + (should (eq (map-delete ht 'a) ht)))) (ert-deftest test-map-nested-elt () (let ((vec [a b [c d [e f]]])) - (assert (eq (map-nested-elt vec '(2 2 0)) 'e))) + (should (eq (map-nested-elt vec '(2 2 0)) 'e))) (let ((alist '((a . 1) (b . ((c . 2) (d . 3) (e . ((f . 4) (g . 5)))))))) - (assert (eq (map-nested-elt alist '(b e f)) + (should (eq (map-nested-elt alist '(b e f)) 4))) (let ((ht (make-hash-table))) (map-put ht 'a 1) (map-put ht 'b (make-hash-table)) (map-put (map-elt ht 'b) 'c 2) - (assert (eq (map-nested-elt ht '(b c)) + (should (eq (map-nested-elt ht '(b c)) 2)))) (ert-deftest test-map-nested-elt-default () (let ((vec [a b [c d]])) - (assert (null (map-nested-elt vec '(2 3)))) - (assert (null (map-nested-elt vec '(2 1 1)))) - (assert (= 4 (map-nested-elt vec '(2 1 1) 4))))) + (should (null (map-nested-elt vec '(2 3)))) + (should (null (map-nested-elt vec '(2 1 1)))) + (should (= 4 (map-nested-elt vec '(2 1 1) 4))))) (ert-deftest test-map-p () - (assert (map-p nil)) - (assert (map-p '((a . b) (c . d)))) - (assert (map-p '(a b c d))) - (assert (map-p [])) - (assert (map-p [1 2 3])) - (assert (map-p (make-hash-table))) - (assert (map-p "hello")) - (assert (not (map-p 1))) - (assert (not (map-p 'hello)))) + (should (map-p nil)) + (should (map-p '((a . b) (c . d)))) + (should (map-p '(a b c d))) + (should (map-p [])) + (should (map-p [1 2 3])) + (should (map-p (make-hash-table))) + (should (map-p "hello")) + (should (not (map-p 1))) + (should (not (map-p 'hello)))) (ert-deftest test-map-keys () (with-maps-do map - (assert (equal (map-keys map) '(0 1 2)))) - (assert (null (map-keys nil))) - (assert (null (map-keys [])))) + (should (equal (map-keys map) '(0 1 2)))) + (should (null (map-keys nil))) + (should (null (map-keys [])))) (ert-deftest test-map-values () (with-maps-do map - (assert (equal (map-values map) '(3 4 5))))) + (should (equal (map-values map) '(3 4 5))))) (ert-deftest test-map-pairs () (with-maps-do map - (assert (equal (map-pairs map) '((0 . 3) + (should (equal (map-pairs map) '((0 . 3) (1 . 4) (2 . 5)))))) @@ -167,27 +167,27 @@ Evaluate BODY for each created map. (puthash 'b 2 ht) (puthash 'c 3 ht) (puthash 'd 4 ht) - (assert (= 0 (map-length nil))) - (assert (= 0 (map-length []))) - (assert (= 0 (map-length (make-hash-table)))) - (assert (= 5 (map-length [0 1 2 3 4]))) - (assert (= 2 (map-length '((a . 1) (b . 2))))) - (assert (= 4 (map-length ht))))) + (should (= 0 (map-length nil))) + (should (= 0 (map-length []))) + (should (= 0 (map-length (make-hash-table)))) + (should (= 5 (map-length [0 1 2 3 4]))) + (should (= 2 (map-length '((a . 1) (b . 2))))) + (should (= 4 (map-length ht))))) (ert-deftest test-map-copy () (with-maps-do map (let ((copy (map-copy map))) - (assert (equal (map-keys map) (map-keys copy))) - (assert (equal (map-values map) (map-values copy))) - (assert (not (eq map copy)))))) + (should (equal (map-keys map) (map-keys copy))) + (should (equal (map-values map) (map-values copy))) + (should (not (eq map copy)))))) (ert-deftest test-map-apply () (with-maps-do map - (assert (equal (map-apply (lambda (k v) (cons (int-to-string k) v)) + (should (equal (map-apply (lambda (k v) (cons (int-to-string k) v)) map) '(("0" . 3) ("1" . 4) ("2" . 5))))) (let ((vec [a b c])) - (assert (equal (map-apply (lambda (k v) (cons (1+ k) v)) + (should (equal (map-apply (lambda (k v) (cons (1+ k) v)) vec) '((1 . a) (2 . b) @@ -195,139 +195,139 @@ Evaluate BODY for each created map. (ert-deftest test-map-keys-apply () (with-maps-do map - (assert (equal (map-keys-apply (lambda (k) (int-to-string k)) + (should (equal (map-keys-apply (lambda (k) (int-to-string k)) map) '("0" "1" "2")))) (let ((vec [a b c])) - (assert (equal (map-keys-apply (lambda (k) (1+ k)) + (should (equal (map-keys-apply (lambda (k) (1+ k)) vec) '(1 2 3))))) (ert-deftest test-map-values-apply () (with-maps-do map - (assert (equal (map-values-apply (lambda (v) (1+ v)) + (should (equal (map-values-apply (lambda (v) (1+ v)) map) '(4 5 6)))) (let ((vec [a b c])) - (assert (equal (map-values-apply (lambda (v) (symbol-name v)) + (should (equal (map-values-apply (lambda (v) (symbol-name v)) vec) '("a" "b" "c"))))) (ert-deftest test-map-filter () (with-maps-do map - (assert (equal (map-keys (map-filter (lambda (k v) + (should (equal (map-keys (map-filter (lambda (k v) (<= 4 v)) map)) '(1 2))) - (assert (null (map-filter (lambda (k v) + (should (null (map-filter (lambda (k v) (eq 'd k)) map)))) - (assert (null (map-filter (lambda (k v) + (should (null (map-filter (lambda (k v) (eq 3 v)) [1 2 4 5]))) - (assert (equal (map-filter (lambda (k v) + (should (equal (map-filter (lambda (k v) (eq 3 k)) [1 2 4 5]) '((3 . 5))))) (ert-deftest test-map-remove () (with-maps-do map - (assert (equal (map-keys (map-remove (lambda (k v) + (should (equal (map-keys (map-remove (lambda (k v) (>= v 4)) map)) '(0))) - (assert (equal (map-keys (map-remove (lambda (k v) + (should (equal (map-keys (map-remove (lambda (k v) (eq 'd k)) map)) (map-keys map)))) - (assert (equal (map-remove (lambda (k v) + (should (equal (map-remove (lambda (k v) (eq 3 v)) [1 2 4 5]) '((0 . 1) (1 . 2) (2 . 4) (3 . 5)))) - (assert (null (map-remove (lambda (k v) + (should (null (map-remove (lambda (k v) (>= k 0)) [1 2 4 5])))) (ert-deftest test-map-empty-p () - (assert (map-empty-p nil)) - (assert (not (map-empty-p '((a . b) (c . d))))) - (assert (map-empty-p [])) - (assert (not (map-empty-p [1 2 3]))) - (assert (map-empty-p (make-hash-table))) - (assert (not (map-empty-p "hello"))) - (assert (map-empty-p ""))) + (should (map-empty-p nil)) + (should (not (map-empty-p '((a . b) (c . d))))) + (should (map-empty-p [])) + (should (not (map-empty-p [1 2 3]))) + (should (map-empty-p (make-hash-table))) + (should (not (map-empty-p "hello"))) + (should (map-empty-p ""))) (ert-deftest test-map-contains-key-p () - (assert (map-contains-key-p '((a . 1) (b . 2)) 'a)) - (assert (not (map-contains-key-p '((a . 1) (b . 2)) 'c))) - (assert (map-contains-key-p '(("a" . 1)) "a")) - (assert (not (map-contains-key-p '(("a" . 1)) "a" #'eq))) - (assert (map-contains-key-p [a b c] 2)) - (assert (not (map-contains-key-p [a b c] 3)))) + (should (map-contains-key-p '((a . 1) (b . 2)) 'a)) + (should (not (map-contains-key-p '((a . 1) (b . 2)) 'c))) + (should (map-contains-key-p '(("a" . 1)) "a")) + (should (not (map-contains-key-p '(("a" . 1)) "a" #'eq))) + (should (map-contains-key-p [a b c] 2)) + (should (not (map-contains-key-p [a b c] 3)))) (ert-deftest test-map-some-p () (with-maps-do map - (assert (equal (map-some-p (lambda (k v) + (should (equal (map-some-p (lambda (k v) (eq 1 k)) map) (cons 1 4))) - (assert (not (map-some-p (lambda (k v) + (should (not (map-some-p (lambda (k v) (eq 'd k)) map)))) (let ((vec [a b c])) - (assert (equal (map-some-p (lambda (k v) + (should (equal (map-some-p (lambda (k v) (> k 1)) vec) (cons 2 'c))) - (assert (not (map-some-p (lambda (k v) + (should (not (map-some-p (lambda (k v) (> k 3)) vec))))) (ert-deftest test-map-every-p () (with-maps-do map - (assert (map-every-p (lambda (k v) + (should (map-every-p (lambda (k v) k) map)) - (assert (not (map-every-p (lambda (k v) + (should (not (map-every-p (lambda (k v) nil) map)))) (let ((vec [a b c])) - (assert (map-every-p (lambda (k v) + (should (map-every-p (lambda (k v) (>= k 0)) vec)) - (assert (not (map-every-p (lambda (k v) + (should (not (map-every-p (lambda (k v) (> k 3)) vec))))) (ert-deftest test-map-into () (let* ((alist '((a . 1) (b . 2))) (ht (map-into alist 'hash-table))) - (assert (hash-table-p ht)) - (assert (equal (map-into (map-into alist 'hash-table) 'list) + (should (hash-table-p ht)) + (should (equal (map-into (map-into alist 'hash-table) 'list) alist)) - (assert (listp (map-into ht 'list))) - (assert (equal (map-keys (map-into (map-into ht 'list) 'hash-table)) + (should (listp (map-into ht 'list))) + (should (equal (map-keys (map-into (map-into ht 'list) 'hash-table)) (map-keys ht))) - (assert (equal (map-values (map-into (map-into ht 'list) 'hash-table)) + (should (equal (map-values (map-into (map-into ht 'list) 'hash-table)) (map-values ht))) - (assert (null (map-into nil 'list))) - (assert (map-empty-p (map-into nil 'hash-table))) + (should (null (map-into nil 'list))) + (should (map-empty-p (map-into nil 'hash-table))) (should-error (map-into [1 2 3] 'string)))) (ert-deftest test-map-let () (map-let (foo bar baz) '((foo . 1) (bar . 2)) - (assert (= foo 1)) - (assert (= bar 2)) - (assert (null baz))) + (should (= foo 1)) + (should (= bar 2)) + (should (null baz))) (map-let ((foo . a) (bar . b) (baz . c)) '((foo . 1) (bar . 2)) - (assert (= a 1)) - (assert (= b 2)) - (assert (null c)))) + (should (= a 1)) + (should (= b 2)) + (should (null c)))) (provide 'map-tests) ;;; map-tests.el ends here commit 18942259ce798a4c5147c10f0cbb0c6138fca08c Author: Glenn Morris Date: Fri Jun 5 16:12:44 2015 -0400 * lisp/Makefile.in (SUBDIRS): Rename from SUBDIRS_ABS. (SUBDIRS_REL): Derive from SUBDIRS. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 9c3bf55..46de989 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -120,16 +120,18 @@ unexport EMACSDATA EMACSDOC EMACSPATH # Prevent any setting of EMACSLOADPATH in user environment causing problems. emacs = EMACSLOADPATH= '$(EMACS)' $(EMACSOPT) -SUBDIRS_REL = $(sort $(shell cd ${srcdir} && find . -type d -print)) -SUBDIRS_ABS = $(sort $(shell find ${srcdir} -type d -print)) +## Subdirectories, relative to builddir. +SUBDIRS = $(sort $(shell find ${srcdir} -type d -print)) +## Subdirectories, relative to srcdir. +SUBDIRS_REL = $(patsubst ${srcdir}%,.%,${SUBDIRS}) ## All subdirectories except 'obsolete' and 'term'. -SUBDIRS_ALMOST = $(filter-out ${srcdir}/obsolete ${srcdir}/term,${SUBDIRS_ABS}) +SUBDIRS_ALMOST = $(filter-out ${srcdir}/obsolete ${srcdir}/term,${SUBDIRS}) ## All subdirectories except 'obsolete', 'term', and 'leim' (and subdirs). ## We don't want the leim files listed as packages, especially ## since many share basenames with files in language/. SUBDIRS_FINDER = $(filter-out ${srcdir}/leim%,${SUBDIRS_ALMOST}) ## All subdirectories in which we might want to create subdirs.el. -SUBDIRS_SUBDIRS = $(filter-out ${srcdir}/cedet% ${srcdir}/leim%,${SUBDIRS_ABS}) +SUBDIRS_SUBDIRS = $(filter-out ${srcdir}/cedet% ${srcdir}/leim%,${SUBDIRS}) # cus-load and finder-inf are not explicitly requested by anything, so # we add them here to make sure they get built. commit 1805ce763ebb40d10c0926f8e97de39e3b988722 Author: Glenn Morris Date: Fri Jun 5 16:10:18 2015 -0400 Tweak some build messages. * lisp/Makefile.in ($(lisp)/loaddefs.el): * lisp/cus-dep.el (custom-make-dependencies): * lisp/finder.el (finder-compile-keywords): Say what we are doing. * lisp/international/titdic-cnv.el (batch-titdic-convert): Don't say how to compile. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 9818d98..9c3bf55 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -175,7 +175,7 @@ $(lisp)/finder-inf.el: # and make this depend on leim. autoloads .PHONY: $(lisp)/loaddefs.el $(lisp)/loaddefs.el: $(LOADDEFS) - @echo Directories: ${SUBDIRS_ALMOST} + @echo Directories for loaddefs: ${SUBDIRS_ALMOST} $(AM_V_GEN)$(emacs) -l autoload \ --eval '(setq autoload-ensure-writable t)' \ --eval '(setq autoload-builtin-package-versions t)' \ diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index b8a9eb8..856c96d 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -60,7 +60,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" ;; Use up command-line-args-left else Emacs can try to open ;; the args as directories after we are done. (while (setq subdir (pop command-line-args-left)) - (message "Directory %s" subdir) + (message "Scanning %s for custom" subdir) (let ((files (directory-files subdir nil "\\`[^=.].*\\.el\\'")) (default-directory (file-name-as-directory (expand-file-name subdir))) diff --git a/lisp/finder.el b/lisp/finder.el index 1ab59f1..715dd94 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -193,7 +193,7 @@ from; the default is `load-path'." summary keywords package version entry desc) (dolist (d (or dirs load-path)) (when (file-exists-p (directory-file-name d)) - (message "Directory %s" d) + (message "Scanning %s for finder" d) (setq package-override (intern-soft (cdr-safe diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el index 12e0883..1186c71 100644 --- a/lisp/international/titdic-cnv.el +++ b/lisp/international/titdic-cnv.el @@ -562,9 +562,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." (message "Converting %s to quail-package..." file) (titdic-convert file targetdir)) (setq files (cdr files))) - (setq command-line-args-left (cdr command-line-args-left))) - (message "Byte-compile the created files by:") - (message " %% emacs -batch -f batch-byte-compile XXX.el"))) + (setq command-line-args-left (cdr command-line-args-left))))) (kill-emacs 0)) commit 34ad02767b8dec902d9e78b38168d71a6b93f94c Author: Eli Zaretskii Date: Fri Jun 5 13:45:02 2015 +0300 ; etc/DEBUG copedits * etc/DEBUG: Improve the section on debugging redisplay issues. Also other minor copyedits. diff --git a/etc/DEBUG b/etc/DEBUG index 52424d7..51a3736 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -34,6 +34,13 @@ With GCC and higher optimization levels such as -O2, the essential. The latter prevents GCC from using the same abort call for all assertions in a given function, rendering the stack backtrace useless for identifying the specific failed assertion. +Some versions of GCC support recent versions of the DWARF standard for +debugging info, but default to older versions; for example, they could +support -gdwarf-4 compiler option (for DWARF v4), but default to +version 2 of the DWARF standard. For best results in debugging +abilities, find out the highest version of DWARF your GCC can support, +and use the corresponding -gdwarf-N switch instead of just -g (you +will still need -g3, as in "-gdwarf-4 -g3"). ** It is a good idea to run Emacs under GDB (or some other suitable debugger) *all the time*. Then, when Emacs crashes, you will be able @@ -76,11 +83,22 @@ use the set command until the inferior process has been started. Put a breakpoint early in `main', or suspend the Emacs, to get an opportunity to do the set command. +Another technique for get control to the debugger is to put a +breakpoint in some rarely used function. One such convenient function +is Fredraw_display, which you can invoke at will interactively with +"M-x redraw-display RET". + When Emacs is running in a terminal, it is sometimes useful to use a separate terminal for the debug session. This can be done by starting Emacs as usual, then attaching to it from gdb with the `attach' command which is explained in the node "Attach" of the GDB manual. +On MS-Windows, you can start Emacs in its own separate terminal by +setting the new-console option before running Emacs under GDB: + + (gdb) set new-console 1 + (gdb) run + ** Examining Lisp object values. When you have a live process to debug, and it has not encountered a @@ -120,6 +138,8 @@ type. Here are these commands: xint xptr xwindow xmarker xoverlay xmiscfree xintfwd xboolfwd xobjfwd xbufobjfwd xkbobjfwd xbuflocal xbuffer xsymbol xstring xvector xframe xwinconfig xcompiled xcons xcar xcdr xsubr xprocess xfloat xscrollbar + xchartable xsubchartable xboolvector xhashtable xlist xcoding + xcharset xfontset xfont xbytecode Each one of them applies to a certain type or class of types. (Some of these types are not visible in Lisp, because they exist only @@ -138,33 +158,32 @@ Here's an example using concepts explained in the node "Value History" of the GDB manual to print values associated with the variable called frame. First, use these commands: - cd src - gdb emacs - b set_frame_buffer_list - r -q + cd src + gdb emacs + b set_frame_buffer_list + r -q Then Emacs hits the breakpoint: - (gdb) p frame - $1 = 139854428 - (gdb) xpr - Lisp_Vectorlike - PVEC_FRAME - $2 = (struct frame *) 0x8560258 - "emacs@localhost" - (gdb) p *$ - $3 = { - size = 1073742931, - next = 0x85dfe58, - name = 140615219, - [...] - } + (gdb) p frame + $1 = 139854428 + (gdb) xpr + Lisp_Vectorlike + PVEC_FRAME + $2 = (struct frame *) 0x8560258 + "emacs@localhost" + (gdb) p *$ + $3 = { + size = 1073742931, + next = 0x85dfe58, + name = 140615219, + [...] + } Now we can use `pr' to print the frame parameters: - (gdb) pp $->param_alist - ((background-mode . light) (display-type . color) [...]) - + (gdb) pp $->param_alist + ((background-mode . light) (display-type . color) [...]) The Emacs C code heavily uses macros defined in lisp.h. So suppose we want the address of the l-value expression near the bottom of @@ -174,28 +193,28 @@ we want the address of the l-value expression near the bottom of XVECTOR is a macro, so GDB only knows about it if Emacs has been compiled with preprocessor macro information. GCC provides this if you specify the options -`-gdwarf-2' and `-g3'. In this case, GDB can evaluate expressions like -"p XVECTOR (this_command_keys)". +`-gdwarf-N' (where N is 2 or higher) and `-g3'. In this case, GDB can +evaluate expressions like "p XVECTOR (this_command_keys)". When this information isn't available, you can use the xvector command in GDB to get the same result. Here is how: - (gdb) p this_command_keys - $1 = 1078005760 - (gdb) xvector - $2 = (struct Lisp_Vector *) 0x411000 - 0 - (gdb) p $->contents[this_command_key_count] - $3 = 1077872640 - (gdb) p &$ - $4 = (int *) 0x411008 + (gdb) p this_command_keys + $1 = 1078005760 + (gdb) xvector + $2 = (struct Lisp_Vector *) 0x411000 + 0 + (gdb) p $->contents[this_command_key_count] + $3 = 1077872640 + (gdb) p &$ + $4 = (int *) 0x411008 Here's a related example of macros and the GDB `define' command. There are many Lisp vectors such as `recent_keys', which contains the last 300 keystrokes. We can print this Lisp vector -p recent_keys -pr + p recent_keys + pr But this may be inconvenient, since `recent_keys' is much more verbose than `C-h l'. We might want to print only the last 10 elements of @@ -206,24 +225,24 @@ this vector. `recent_keys' is updated in keyboard.c by the command So we define a GDB command `xvector-elts', so the last 10 keystrokes are printed by - xvector-elts recent_keys recent_keys_index 10 + xvector-elts recent_keys recent_keys_index 10 where you can define xvector-elts as follows: - define xvector-elts - set $i = 0 - p $arg0 - xvector - set $foo = $ - while $i < $arg2 - p $foo->contents[$arg1-($i++)] - pr - end - document xvector-elts - Prints a range of elements of a Lisp vector. - xvector-elts v n i - prints `i' elements of the vector `v' ending at the index `n'. - end + define xvector-elts + set $i = 0 + p $arg0 + xvector + set $foo = $ + while $i < $arg2 + p $foo->contents[$arg1-($i++)] + pr + end + document xvector-elts + Prints a range of elements of a Lisp vector. + xvector-elts v n i + prints `i' elements of the vector `v' ending at the index `n'. + end ** Getting Lisp-level backtrace information within GDB @@ -259,7 +278,53 @@ and, assuming that "xtype" says that args[0] is a symbol: xsymbol -** Debugging Emacs Redisplay problems +** Debugging Emacs redisplay problems + +If you configured Emacs with --enable-checking='glyphs', you can use redisplay +tracing facilities from a running Emacs session. + +The command "M-x trace-redisplay RET" will produce a trace of what redisplay +does on the standard error stream. This is very useful for understanding the +code paths taken by the display engine under various conditions, especially if +some redisplay optimizations produce wrong results. (You know that redisplay +optimizations might be involved if "M-x redraw-display RET", or even just +typing "M-x", causes Emacs to correct the bad display.) Since the cursor +blinking feature triggers periodic redisplay cycles, we recommend disabling +`blink-cursor-mode' before invoking `trace-redisplay', so that you have less +clutter in the trace. You can also have up to 30 last trace messages dumped to +standard error by invoking the `dump-redisplay-history' command. + +To find the code paths which were taken by the display engine, search xdisp.c +for the trace messages you see. + +The command `dump-glyph-matrix' is useful for producing on standard error +stream a full dump of the selected window's glyph matrix. See the function's +doc string for more details. If you are debugging redisplay issues in +text-mode frames, you may find the command `dump-frame-glyph-matrix' useful. + +Other commands useful for debugging redisplay are `dump-glyph-row' and +`dump-tool-bar-row'. + +If you run Emacs under GDB, you can print the contents of any glyph matrix by +just calling that function with the matrix as its argument. For example, the +following command will print the contents of the current matrix of the window +whose pointer is in `w': + + (gdb) p dump_glyph_matrix (w->current_matrix, 2) + +(The second argument 2 tells dump_glyph_matrix to print the glyphs in +a long form.) + +The Emacs display code includes special debugging code, but it is normally +disabled. Configuring Emacs with --enable-checking='yes,glyphs' enables it. + +Building Emacs like that activates many assertions which scrutinize +display code operation more than Emacs does normally. (To see the +code which tests these assertions, look for calls to the `eassert' +macros.) Any assertion that is reported to fail should be investigated. + +When you debug display problems running emacs under X, you can use +the `ff' command to flush all pending display updates to the screen. The src/.gdbinit file defines many useful commands for dumping redisplay related data structures in a terse and user-friendly format: @@ -273,8 +338,53 @@ related data structures in a terse and user-friendly format: `pgrow' dumps all glyphs in current glyph_row `row'. `pcursor' dumps current output_cursor. -The above commands also exist in a version with an `x' suffix which -takes an object of the relevant type as argument. +The above commands also exist in a version with an `x' suffix which takes an +object of the relevant type as argument. For example, `pgrowx' dumps all +glyphs in its argument, which must be of type `struct glyph_row'. + +Since redisplay is performed by Emacs very frequently, you need to place your +breakpoints cleverly to avoid hitting them all the time, when the issue you are +debugging did not (yet) happen. Here are some useful techniques for that: + + . Put a breakpoint at `Fredraw_display' before running Emacs. Then do + whatever is required to reproduce the bad display, and invoke "M-x + redraw-display". The debugger will kick in, and you can set or enable + breakpoints in strategic places, knowing that the bad display will be + redrawn from scratch. + + . For debugging incorrect cursor position, a good place to put a breakpoint is + in `set_cursor_from_row'. The first time this function is called as part of + `redraw-display', Emacs is redrawing the minibuffer window, which is usually + not what you want; type "continue" to get to the call you want. In general, + always make sure `set_cursor_from_row' is called for the right window and + buffer by examining the value of w->contents: it should be the buffer whose + display you are debugging. + + . `set_cursor_from_row' is also a good place to look at the contents of a + screen line (a.k.a. "glyph row"), by means of the `pgrow' GDB command. Of + course, you need first to make sure the cursor is on the screen line which + you want to investigate. If you have set a breakpoint in `Fredraw_display', + as advised above, move cursor to that line before invoking `redraw-display'. + + . If the problem happens only at some specific buffer position or for some + specific rarely-used character, you can make your breakpoints conditional on + those values. The display engine maintains the buffer and string position + it is processing in the it->current member; for example, the buffer + character position is in it->current.pos.charpos. Most redisplay functions + accept a pointer to a 'struct it' object as their argument, so you can make + conditional breakpoints in those functions, like this: + + (gdb) break x_produce_glyphs if it->current.pos.charpos == 1234 + + For conditioning on the character being displayed, use it->c or + it->char_to_display. + + . You can also make the breakpoints conditional on what object is being used + for producing glyphs for display. The it->method member has the value + GET_FROM_BUFFER for displaying buffer contents, GET_FROM_STRING for + displaying a Lisp string (e.g., a `display' property or an overlay string), + GET_FROM_IMAGE for displaying an image, etc. See `enum it_method' in + dispextern.h for the full list of values. ** Following longjmp call. @@ -304,18 +414,18 @@ features available just for debugging Emacs: ** Debugging what happens while preloading and dumping Emacs -Type `gdb temacs' and start it with `r -batch -l loadup dump'. +Debugging `temacs' is useful when you want to establish whether a +problem happens in an undumped Emacs. To run `temacs' under a +debugger, type "gdb temacs", then start it with `r -batch -l loadup'. + +If you need to debug what happens during dumping, start it with `r -batch -l +loadup dump' instead. For debugging the bootstrap dumping, use "loadup +bootstrap" instead of "loadup dump". If temacs actually succeeds when running under GDB in this way, do not try to run the dumped Emacs, because it was dumped with the GDB breakpoints in it. -** Debugging `temacs' - -Debugging `temacs' is useful when you want to establish whether a -problem happens in an undumped Emacs. To run `temacs' under a -debugger, type "gdb temacs", then start it with `r -batch -l loadup'. - ** If you encounter X protocol errors The X server normally reports protocol errors asynchronously, @@ -469,8 +579,7 @@ Then, if Emacs becomes hopelessly wedged, you can create another window to do kill -9 in. kill -ILL is often useful too, since that may make Emacs dump core or return to adb. - -** Debugging incorrect screen updating. +** Debugging incorrect screen updating on a text terminal. To debug Emacs problems that update the screen wrong, it is useful to have a record of what input you typed and what Emacs sent to the @@ -494,40 +603,6 @@ evaluate `(setq inverse-video t)' before you try the operation you think will cause too much redrawing. This doesn't refresh the screen, so only newly drawn text is in inverse video. -The Emacs display code includes special debugging code, but it is -normally disabled. You can enable it by building Emacs with the -pre-processing symbol GLYPH_DEBUG defined. Here's one easy way, -suitable for Unix and GNU systems, to build such a debugging version: - - MYCPPFLAGS='-DGLYPH_DEBUG=1' make - -Building Emacs like that activates many assertions which scrutinize -display code operation more than Emacs does normally. (To see the -code which tests these assertions, look for calls to the `xassert' -macros.) Any assertion that is reported to fail should be investigated. - -Building with GLYPH_DEBUG defined also defines several helper -functions which can help debugging display code. One such function is -`dump_glyph_matrix'. If you run Emacs under GDB, you can print the -contents of any glyph matrix by just calling that function with the -matrix as its argument. For example, the following command will print -the contents of the current matrix of the window whose pointer is in `w': - - (gdb) p dump_glyph_matrix (w->current_matrix, 2) - -(The second argument 2 tells dump_glyph_matrix to print the glyphs in -a long form.) You can dump the selected window's current glyph matrix -interactively with "M-x dump-glyph-matrix RET"; see the documentation -of this function for more details. - -Several more functions for debugging display code are available in -Emacs compiled with GLYPH_DEBUG defined; type "C-h f dump- TAB" and -"C-h f trace- TAB" to see the full list. - -When you debug display problems running emacs under X, you can use -the `ff' command to flush all pending display updates to the screen. - - ** Debugging LessTif If you encounter bugs whereby Emacs built with LessTif grabs all mouse @@ -550,7 +625,6 @@ You can arrange for GDB to run on one machine, with the Emacs display appearing on another. Then, when the bug happens, you can go back to the machine where you started GDB and use the debugger from there. - ** Debugging problems which happen in GC The array `last_marked' (defined on alloc.c) can be used to display up @@ -629,6 +703,12 @@ directed to the xterm window you opened above. Similar arrangement is possible on a character terminal by using the `screen' package. +On MS-Windows, you can start Emacs in its own separate terminal by +setting the new-console option before running Emacs under GDB: + + (gdb) set new-console 1 + (gdb) run + ** Running Emacs built with malloc debugging packages If Emacs exhibits bugs that seem to be related to use of memory commit 957cbfd7650e6ebd1afc62daeb5f6923730112c9 (refs/remotes/origin/scratch/large-fonts) Author: Eli Zaretskii Date: Mon Jun 1 17:46:20 2015 +0300 NS equivalents of xterm.c and w32term.c changes * src/nsterm.m (ns_maybe_dumpglyphs_background): Force redraw of glyph string background also when the font in use claims preposterously large global height value. Helps to remove artifacts left from previous displays when glyphless characters are displayed as hex code in a box. (x_new_font): Call get_font_ascent_descent to obtain a reasonable value for FRAME_LINE_HEIGHT, even when a font claims very large value for its height. diff --git a/src/nsterm.m b/src/nsterm.m index 67a0389..2806f31 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -2928,6 +2928,11 @@ ns_maybe_dumpglyphs_background (struct glyph_string *s, char force_p) { int box_line_width = max (s->face->box_line_width, 0); if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width + /* When xdisp.c ignores FONT_HEIGHT, we cannot trust font + dimensions, since the actual glyphs might be much + smaller. So in that case we always clear the rectangle + with background color. */ + || FONT_TOO_HIGH (s->font) || s->font_not_found_p || s->extends_to_end_of_line_p || force_p) { struct face *face; @@ -7687,6 +7692,7 @@ x_new_font (struct frame *f, Lisp_Object font_object, int fontset) { struct font *font = XFONT_OBJECT (font_object); EmacsView *view = FRAME_NS_VIEW (f); + int font_ascent, font_descent; if (fontset < 0) fontset = fontset_from_font (font_object); @@ -7701,7 +7707,8 @@ x_new_font (struct frame *f, Lisp_Object font_object, int fontset) FRAME_BASELINE_OFFSET (f) = font->baseline_offset; FRAME_COLUMN_WIDTH (f) = font->average_width; - FRAME_LINE_HEIGHT (f) = font->height; + get_font_ascent_descent (font, &font_ascent, &font_descent); + FRAME_LINE_HEIGHT (f) = font_ascent + font_descent; /* Compute the scroll bar width in character columns. */ if (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0) commit cab645a62f3e5963ee7da94eb9c33961601c6651 Author: Eli Zaretskii Date: Sun May 31 17:41:35 2015 +0300 Attempt to fix crashes due to accesses beyond glyph matrix end * src/xdisp.c (x_produce_glyphs): When it->ascent and it->descent are determined from per-character metrics, don't let the max_ascent and max_descent become smaller than values returned by normal_char_ascent_descent, to avoid unpleasant dynamic resizing of screen line heights when text changes. * src/xterm.c (x_new_font) * src/w32term.c (x_new_font): Call get_font_ascent_descent to obtain a reasonable value for FRAME_LINE_HEIGHT, even when a font claims very large value for its height. * src/font.c (font_open_entity): Call get_font_ascent_descent to obtain a reasonable value for FRAME_SMALLEST_FONT_HEIGHT, even when a font claims very large value for its height. diff --git a/src/font.c b/src/font.c index 2ccfd15..903a0a6 100644 --- a/src/font.c +++ b/src/font.c @@ -2908,7 +2908,12 @@ font_open_entity (struct frame *f, Lisp_Object entity, int pixel_size) : font->average_width ? font->average_width : font->space_width ? font->space_width : 1); - height = (font->height ? font->height : 1); + + int font_ascent, font_descent; + get_font_ascent_descent (font, &font_ascent, &font_descent); + height = font_ascent + font_descent; + if (height <= 0) + height = 1; #ifdef HAVE_WINDOW_SYSTEM FRAME_DISPLAY_INFO (f)->n_fonts++; if (FRAME_DISPLAY_INFO (f)->n_fonts == 1) diff --git a/src/w32term.c b/src/w32term.c index 9c4f28f..b7c6e13 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -5832,7 +5832,7 @@ Lisp_Object x_new_font (struct frame *f, Lisp_Object font_object, int fontset) { struct font *font = XFONT_OBJECT (font_object); - int unit; + int unit, font_ascent, font_descent; if (fontset < 0) fontset = fontset_from_font (font_object); @@ -5845,7 +5845,8 @@ x_new_font (struct frame *f, Lisp_Object font_object, int fontset) FRAME_FONT (f) = font; FRAME_BASELINE_OFFSET (f) = font->baseline_offset; FRAME_COLUMN_WIDTH (f) = unit = font->average_width; - FRAME_LINE_HEIGHT (f) = font->height; + get_font_ascent_descent (font, &font_ascent, &font_descent); + FRAME_LINE_HEIGHT (f) = font_ascent + font_descent; /* Compute number of scrollbar columns. */ unit = FRAME_COLUMN_WIDTH (f); diff --git a/src/xdisp.c b/src/xdisp.c index 5330327..ea9b05e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -26763,6 +26763,22 @@ x_produce_glyphs (struct it *it) it->nglyphs = 1; } } + + if (FONT_TOO_HIGH (font)) + { + int font_ascent, font_descent; + + /* For very large fonts, where we ignore the declared font + dimensions, and go by per-character metrics instead, + don't let the row ascent and descent values (and the row + height computed from them) be smaller than the "normal" + character metrics. This avoids unpleasant effects + whereby lines on display would change their heigh + depending on which characters are shown. */ + normal_char_ascent_descent (font, -1, &font_ascent, &font_descent); + it->max_ascent = max (it->max_ascent, font_ascent); + it->max_descent = max (it->max_descent, font_descent); + } } else if (it->what == IT_COMPOSITION && it->cmp_it.ch < 0) { diff --git a/src/xterm.c b/src/xterm.c index 58563ff..ac77d80 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9410,7 +9410,7 @@ Lisp_Object x_new_font (struct frame *f, Lisp_Object font_object, int fontset) { struct font *font = XFONT_OBJECT (font_object); - int unit; + int unit, font_ascent, font_descent; if (fontset < 0) fontset = fontset_from_font (font_object); @@ -9423,7 +9423,8 @@ x_new_font (struct frame *f, Lisp_Object font_object, int fontset) FRAME_FONT (f) = font; FRAME_BASELINE_OFFSET (f) = font->baseline_offset; FRAME_COLUMN_WIDTH (f) = font->average_width; - FRAME_LINE_HEIGHT (f) = FONT_HEIGHT (font); + get_font_ascent_descent (font, &font_ascent, &font_descent); + FRAME_LINE_HEIGHT (f) = font_ascent + font_descent; #ifndef USE_X_TOOLKIT FRAME_MENU_BAR_HEIGHT (f) = FRAME_MENU_BAR_LINES (f) * FRAME_LINE_HEIGHT (f); commit 643470ff797407b256eea380e0f41d3749400927 Author: Eli Zaretskii Date: Sat May 30 19:25:53 2015 +0300 Fix display of composite characters with large fonts * src/xdisp.c (x_produce_glyphs): Call normal_char_ascent_descent for reasonable values of font ascent and descent. (get_font_ascent_descent): New function. * src/composite.c (composition_gstring_width): Call get_font_ascent_descent for reasonable values of font ascent and descent. * dispextern.h: Add prototype for get_font_ascent_descent. diff --git a/src/composite.c b/src/composite.c index 577b979..e942eef 100644 --- a/src/composite.c +++ b/src/composite.c @@ -732,9 +732,11 @@ composition_gstring_width (Lisp_Object gstring, ptrdiff_t from, ptrdiff_t to, if (FONT_OBJECT_P (font_object)) { struct font *font = XFONT_OBJECT (font_object); + int font_ascent, font_descent; - metrics->ascent = font->ascent; - metrics->descent = font->descent; + get_font_ascent_descent (font, &font_ascent, &font_descent); + metrics->ascent = font_ascent; + metrics->descent = font_descent; } else { diff --git a/src/dispextern.h b/src/dispextern.h index 1537d44..5202142 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3246,6 +3246,8 @@ extern ptrdiff_t compute_display_string_end (ptrdiff_t, extern void produce_stretch_glyph (struct it *); extern int merge_glyphless_glyph_face (struct it *); +extern void get_font_ascent_descent (struct font *, int *, int *); + #ifdef HAVE_WINDOW_SYSTEM #ifdef GLYPH_DEBUG diff --git a/src/xdisp.c b/src/xdisp.c index 50d7376..5330327 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -24079,6 +24079,17 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop, return false; } +void +get_font_ascent_descent (struct font *font, int *ascent, int *descent) +{ +#ifdef HAVE_WINDOW_SYSTEM + normal_char_ascent_descent (font, -1, ascent, descent); +#else + *ascent = 1; + *descent = 0; +#endif +} + /*********************************************************************** Glyph Display @@ -26818,9 +26829,10 @@ x_produce_glyphs (struct it *it) boff = font->baseline_offset; if (font->vertical_centering) boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff; - font_ascent = FONT_BASE (font) + boff; - font_descent = FONT_DESCENT (font) - boff; - font_height = FONT_HEIGHT (font); + normal_char_ascent_descent (font, -1, &font_ascent, &font_descent); + font_ascent += boff; + font_descent -= boff; + font_height = font_ascent + font_descent; cmp->font = font; commit ba5f83dfe5dea1b9dd3fca5d21384afc92cd2060 Author: Eli Zaretskii Date: Sat May 30 12:33:08 2015 +0300 Fix display of cursor at end of empty lines * src/xdisp.c (normal_char_ascent_descent): Accept additional argument: the character to use for metrics in case the font declares too large ascent and descent values. Add 1 pixel to ascent and descent values. (normal_char_height): Accept additional argument: the character to use for metrics in case the font declares too large height value. Call normal_char_ascent_descent instead of doing calculations for a different default character. (estimate_mode_line_height, handle_single_display_spec) (calc_pixel_width_or_height, produce_stretch_glyph) (calc_line_height_property, produce_glyphless_glyph): All callers changed. (append_space_for_newline): Make sure the space glyph produced at end of line has correct ascent and descent values, and the glyph row has correct height, even when it's empty. diff --git a/src/xdisp.c b/src/xdisp.c index 1fd84f8..50d7376 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -833,7 +833,9 @@ static void x_draw_bottom_divider (struct window *w); static void notice_overwritten_cursor (struct window *, enum glyph_row_area, int, int, int, int); -static int normal_char_height (struct font *); +static int normal_char_height (struct font *, int); +static void normal_char_ascent_descent (struct font *, int, int *, int *); + static void append_stretch_glyph (struct it *, Lisp_Object, int, int, int); @@ -1762,7 +1764,7 @@ estimate_mode_line_height (struct frame *f, enum face_id face_id) if (face) { if (face->font) - height = normal_char_height (face->font); + height = normal_char_height (face->font, -1); if (face->box_line_width > 0) height += 2 * face->box_line_width; } @@ -4889,7 +4891,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, { struct face *face = FACE_FROM_ID (it->f, it->face_id); it->voffset = - (XFLOATINT (value) - * (normal_char_height (face->font))); + * (normal_char_height (face->font, -1))); } #endif /* HAVE_WINDOW_SYSTEM */ } @@ -19212,10 +19214,22 @@ append_space_for_newline (struct it *it, bool default_face_p) PRODUCE_GLYPHS (it); - /* Make sure this space glyph has the right ascent value, or - else hollow cursor at end of line will look funny. */ + /* Make sure this space glyph has the right ascent and + descent values, or else cursor at end of line will look + funny. */ g = it->glyph_row->glyphs[TEXT_AREA] + n; - g->ascent = it->glyph_row->ascent; + struct font *font = face->font ? face->font : FRAME_FONT (it->f); + if (n == 0 || it->glyph_row->height < font->pixel_size) + { + normal_char_ascent_descent (font, -1, &it->ascent, &it->descent); + it->max_ascent = it->ascent; + it->max_descent = it->descent; + /* Make sure compute_line_metrics recomputes the row height. */ + it->glyph_row->height = 0; + } + + g->ascent = it->max_ascent; + g->descent = it->max_descent; it->override_ascent = -1; it->constrain_row_ascent_descent_p = false; @@ -23930,7 +23944,7 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop, #ifdef HAVE_WINDOW_SYSTEM if (EQ (prop, Qheight)) return OK_PIXELS (font - ? normal_char_height (font) + ? normal_char_height (font, -1) : FRAME_LINE_HEIGHT (it->f)); if (EQ (prop, Qwidth)) return OK_PIXELS (font @@ -24569,39 +24583,14 @@ get_per_char_metric (struct font *font, XChar2b *char2b) return &metrics; } -/* A subroutine that computes a reasonable "normal character height" - for fonts that claim preposterously large vertical dimensions, but - whose glyphs are actually reasonably sized. */ -static int -normal_char_height (struct font *font) -{ - int default_height = FONT_HEIGHT (font); - - /* If the font claims too large height, use the metrics of the SPC - character instead. Note that this could still fail to produce a - better value if the font or the font driver don't support the - functionality required by get_per_char_metric. */ - if (FONT_TOO_HIGH (font)) - { - XChar2b char2b; - - /* Get metrics of the SPC character. */ - if (get_char_glyph_code (' ', font, &char2b)) - { - struct font_metrics *pcm = get_per_char_metric (font, &char2b); - - if (!(pcm->width == 0 && pcm->rbearing == 0 && pcm->lbearing == 0)) - default_height = pcm->ascent + pcm->descent; - } - } - return default_height; -} - -/* A subroutine that computes "normal" values of ascent and descent - for fonts that claim preposterously large values, but whose glyphs - actually have reasonable dimensions. */ +/* A subroutine that computes "normal" values of ASCENT and DESCENT + for FONT. Values are taken from font-global ones, except for fonts + that claim preposterously large values, but whose glyphs actually + have reasonable dimensions. C is the character to use for metrics + if the font-global values are too large; if C is negative, the + function selects a default character. */ static void -normal_char_ascent_descent (struct font *font, int *ascent, int *descent) +normal_char_ascent_descent (struct font *font, int c, int *ascent, int *descent) { *ascent = FONT_BASE (font); *descent = FONT_DESCENT (font); @@ -24610,20 +24599,39 @@ normal_char_ascent_descent (struct font *font, int *ascent, int *descent) { XChar2b char2b; - /* Get metrics of a reasonably sized ASCII character. */ - if (get_char_glyph_code ('{', font, &char2b)) + /* Get metrics of C, defaulting to a reasonably sized ASCII + character. */ + if (get_char_glyph_code (c >= 0 ? c : '{', font, &char2b)) { struct font_metrics *pcm = get_per_char_metric (font, &char2b); if (!(pcm->width == 0 && pcm->rbearing == 0 && pcm->lbearing == 0)) { - *ascent = pcm->ascent; - *descent = pcm->descent; + /* We add 1 pixel to character dimensions as heuristics + that produces nicer display, e.g. when the face has + the box attribute. */ + *ascent = pcm->ascent + 1; + *descent = pcm->descent + 1; } } } } +/* A subroutine that computes a reasonable "normal character height" + for fonts that claim preposterously large vertical dimensions, but + whose glyphs are actually reasonably sized. C is the charcater + whose metrics to use for those fonts, or -1 for default + character. */ +static int +normal_char_height (struct font *font, int c) +{ + int ascent, descent; + + normal_char_ascent_descent (font, c, &ascent, &descent); + + return ascent + descent; +} + /* EXPORT for RIF: Set *LEFT and *RIGHT to the left and right overhang of GLYPH on frame F. Overhangs of glyphs other than type CHAR_GLYPH are @@ -25923,7 +25931,7 @@ produce_stretch_glyph (struct it *it) /* Compute height. */ if (FRAME_WINDOW_P (it->f)) { - int default_height = normal_char_height (font); + int default_height = normal_char_height (font, ' '); if ((prop = Fplist_get (plist, QCheight), !NILP (prop)) && calc_pixel_width_or_height (&tem, it, prop, font, false, 0)) @@ -26159,7 +26167,7 @@ calc_line_height_property (struct it *it, Lisp_Object val, struct font *font, boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff; } - normal_char_ascent_descent (font, &ascent, &descent); + normal_char_ascent_descent (font, -1, &ascent, &descent); if (override) { @@ -26285,7 +26293,7 @@ produce_glyphless_glyph (struct it *it, bool for_no_font, Lisp_Object acronym) ASCII face. */ face = FACE_FROM_ID (it->f, it->face_id)->ascii_face; font = face->font ? face->font : FRAME_FONT (it->f); - normal_char_ascent_descent (font, &it->ascent, &it->descent); + normal_char_ascent_descent (font, -1, &it->ascent, &it->descent); it->ascent += font->baseline_offset; it->descent -= font->baseline_offset; base_height = it->ascent + it->descent; commit 42a7b12bc774e1e211204f90aed77c9ca6ffd158 Author: Eli Zaretskii Date: Fri May 29 17:21:07 2015 +0300 Fix 2 more calculations of line height * src/xdisp.c (estimate_mode_line_height, handle_single_display_spec): Use normal_char_height. diff --git a/src/xdisp.c b/src/xdisp.c index 29b97ab..1fd84f8 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1762,7 +1762,7 @@ estimate_mode_line_height (struct frame *f, enum face_id face_id) if (face) { if (face->font) - height = FONT_HEIGHT (face->font); + height = normal_char_height (face->font); if (face->box_line_width > 0) height += 2 * face->box_line_width; } @@ -4889,7 +4889,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, { struct face *face = FACE_FROM_ID (it->f, it->face_id); it->voffset = - (XFLOATINT (value) - * (FONT_HEIGHT (face->font))); + * (normal_char_height (face->font))); } #endif /* HAVE_WINDOW_SYSTEM */ } commit 5f734fa045c7d10c46c3a25ddd6e5f3d6b45182a Author: Eli Zaretskii Date: Fri May 29 17:09:45 2015 +0300 Fix line dimensions from line-height property * src/xdisp.c (normal_char_ascent_descent): New function, extracted from produce_glyphless_glyph. (calc_line_height_property, produce_glyphless_glyph): Use it to compute reasonable estimates of ascent and descent for large fonts. diff --git a/src/xdisp.c b/src/xdisp.c index f3a3a7f..29b97ab 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -24597,6 +24597,33 @@ normal_char_height (struct font *font) return default_height; } +/* A subroutine that computes "normal" values of ascent and descent + for fonts that claim preposterously large values, but whose glyphs + actually have reasonable dimensions. */ +static void +normal_char_ascent_descent (struct font *font, int *ascent, int *descent) +{ + *ascent = FONT_BASE (font); + *descent = FONT_DESCENT (font); + + if (FONT_TOO_HIGH (font)) + { + XChar2b char2b; + + /* Get metrics of a reasonably sized ASCII character. */ + if (get_char_glyph_code ('{', font, &char2b)) + { + struct font_metrics *pcm = get_per_char_metric (font, &char2b); + + if (!(pcm->width == 0 && pcm->rbearing == 0 && pcm->lbearing == 0)) + { + *ascent = pcm->ascent; + *descent = pcm->descent; + } + } + } +} + /* EXPORT for RIF: Set *LEFT and *RIGHT to the left and right overhang of GLYPH on frame F. Overhangs of glyphs other than type CHAR_GLYPH are @@ -26132,8 +26159,7 @@ calc_line_height_property (struct it *it, Lisp_Object val, struct font *font, boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff; } - ascent = FONT_BASE (font) + boff; - descent = FONT_DESCENT (font) - boff; + normal_char_ascent_descent (font, &ascent, &descent); if (override) { @@ -26259,26 +26285,7 @@ produce_glyphless_glyph (struct it *it, bool for_no_font, Lisp_Object acronym) ASCII face. */ face = FACE_FROM_ID (it->f, it->face_id)->ascii_face; font = face->font ? face->font : FRAME_FONT (it->f); - it->ascent = FONT_BASE (font); - it->descent = FONT_DESCENT (font); - /* Attempt to fix box height for fonts that claim preposterously - large height. */ - if (FONT_TOO_HIGH (font)) - { - XChar2b char2b; - - /* Get metrics of a reasonably sized ASCII character. */ - if (get_char_glyph_code ('{', font, &char2b)) - { - struct font_metrics *pcm = get_per_char_metric (font, &char2b); - - if (!(pcm->width == 0 && pcm->rbearing == 0 && pcm->lbearing == 0)) - { - it->ascent = pcm->ascent; - it->descent = pcm->descent; - } - } - } + normal_char_ascent_descent (font, &it->ascent, &it->descent); it->ascent += font->baseline_offset; it->descent -= font->baseline_offset; base_height = it->ascent + it->descent; commit c5228486590c1f31c56f9ea67667617966818cba Author: Eli Zaretskii Date: Fri May 29 16:41:10 2015 +0300 Fix display of stretch glyphs with large fonts * src/xdisp.c (normal_char_height): New function. (calc_pixel_width_or_height, produce_stretch_glyph): Use it to compute more reasonable estimation of a "normal character height" when the font claims preposterously large height values. diff --git a/src/xdisp.c b/src/xdisp.c index ed430a4..f3a3a7f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -833,6 +833,7 @@ static void x_draw_bottom_divider (struct window *w); static void notice_overwritten_cursor (struct window *, enum glyph_row_area, int, int, int, int); +static int normal_char_height (struct font *); static void append_stretch_glyph (struct it *, Lisp_Object, int, int, int); @@ -23928,9 +23929,13 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop, #ifdef HAVE_WINDOW_SYSTEM if (EQ (prop, Qheight)) - return OK_PIXELS (font ? FONT_HEIGHT (font) : FRAME_LINE_HEIGHT (it->f)); + return OK_PIXELS (font + ? normal_char_height (font) + : FRAME_LINE_HEIGHT (it->f)); if (EQ (prop, Qwidth)) - return OK_PIXELS (font ? FONT_WIDTH (font) : FRAME_COLUMN_WIDTH (it->f)); + return OK_PIXELS (font + ? FONT_WIDTH (font) + : FRAME_COLUMN_WIDTH (it->f)); #else if (EQ (prop, Qheight) || EQ (prop, Qwidth)) return OK_PIXELS (1); @@ -24564,6 +24569,34 @@ get_per_char_metric (struct font *font, XChar2b *char2b) return &metrics; } +/* A subroutine that computes a reasonable "normal character height" + for fonts that claim preposterously large vertical dimensions, but + whose glyphs are actually reasonably sized. */ +static int +normal_char_height (struct font *font) +{ + int default_height = FONT_HEIGHT (font); + + /* If the font claims too large height, use the metrics of the SPC + character instead. Note that this could still fail to produce a + better value if the font or the font driver don't support the + functionality required by get_per_char_metric. */ + if (FONT_TOO_HIGH (font)) + { + XChar2b char2b; + + /* Get metrics of the SPC character. */ + if (get_char_glyph_code (' ', font, &char2b)) + { + struct font_metrics *pcm = get_per_char_metric (font, &char2b); + + if (!(pcm->width == 0 && pcm->rbearing == 0 && pcm->lbearing == 0)) + default_height = pcm->ascent + pcm->descent; + } + } + return default_height; +} + /* EXPORT for RIF: Set *LEFT and *RIGHT to the left and right overhang of GLYPH on frame F. Overhangs of glyphs other than type CHAR_GLYPH are @@ -25863,6 +25896,8 @@ produce_stretch_glyph (struct it *it) /* Compute height. */ if (FRAME_WINDOW_P (it->f)) { + int default_height = normal_char_height (font); + if ((prop = Fplist_get (plist, QCheight), !NILP (prop)) && calc_pixel_width_or_height (&tem, it, prop, font, false, 0)) { @@ -25871,9 +25906,9 @@ produce_stretch_glyph (struct it *it) } else if (prop = Fplist_get (plist, QCrelative_height), NUMVAL (prop) > 0) - height = FONT_HEIGHT (font) * NUMVAL (prop); + height = default_height * NUMVAL (prop); else - height = FONT_HEIGHT (font); + height = default_height; if (height <= 0 && (height < 0 || !zero_height_ok_p)) height = 1; commit c76605faa1f597e67df1e5c6cfae5230ff3a6a76 Author: Eli Zaretskii Date: Thu May 28 20:23:41 2015 +0300 Fix display of glyphless characters with problematic fonts * src/w32term.c (x_draw_glyph_string_background): Force redraw of glyph string background also when the font in use claims preposterously large global height value. Helps to remove artifacts left from previous displays when glyphless characters are displayed as hex code in a box. * src/xterm.c (x_draw_glyph_string_background): Force redraw of glyph string background also when the font in use claims preposterously large global height value. Helps to remove artifacts left from previous displays when glyphless characters are displayed as hex code in a box. * src/w32font.c (w32font_draw): Fix background drawing for glyphless characters that display as acronyms or hex codes in a box. * src/xftfont.c (xftfont_draw): Fix background drawing for glyphless characters that display as acronyms or hex codes in a box. * src/xdisp.c (produce_glyphless_glyph): Compute reasonable values for it->ascent and it->descent when the font claims preposterously large global values. (FONT_TOO_HIGH): Move from here... * src/dispextern.h (FONT_TOO_HIGH): ...to here. diff --git a/src/dispextern.h b/src/dispextern.h index d9d4d23..1537d44 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -1526,6 +1526,12 @@ struct glyph_string + (FRAME_LINE_HEIGHT ((F)) > FONT_HEIGHT ((FONT)))) / 2 \ - (FONT_DESCENT (FRAME_FONT (F)) - FRAME_BASELINE_OFFSET (F))) +/* A heuristic test for fonts that claim they need a preposterously + large vertical space. The heuristics is in the factor of 3. We + ignore the ascent and descent values reported by such fonts, and + instead go by the values reported for individual glyphs. */ +#define FONT_TOO_HIGH(ft) ((ft)->ascent + (ft)->descent > 3*(ft)->pixel_size) + /*********************************************************************** Faces diff --git a/src/w32font.c b/src/w32font.c index 6306a84..1c2f966 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -650,12 +650,31 @@ w32font_draw (struct glyph_string *s, int from, int to, HBRUSH brush; RECT rect; struct font *font = s->font; - + int ascent = font->ascent, descent = font->descent; + + /* Font's global ascent and descent values might be + preposterously large for some fonts. We fix here the case + when those fonts are used for display of glyphless + characters, because drawing background with font dimensions + in those cases makes the display illegible. There's only one + more call to the draw method with with_background set to + true, and that's in x_draw_glyph_string_foreground, when + drawing the cursor, where we have no such heuristics + available. FIXME. */ + if (s->first_glyph->type == GLYPHLESS_GLYPH + && (s->first_glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE + || s->first_glyph->u.glyphless.method == GLYPHLESS_DISPLAY_ACRONYM)) + { + ascent = + s->first_glyph->slice.glyphless.lower_yoff + - s->first_glyph->slice.glyphless.upper_yoff; + descent = 0; + } brush = CreateSolidBrush (s->gc->background); rect.left = x; - rect.top = y - font->ascent; + rect.top = y - ascent; rect.right = x + s->width; - rect.bottom = y + font->descent; + rect.bottom = y + descent; FillRect (s->hdc, &rect, brush); DeleteObject (brush); } diff --git a/src/w32term.c b/src/w32term.c index 0bc2e98..9c4f28f 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -1218,7 +1218,12 @@ x_draw_glyph_string_background (struct glyph_string *s, bool force_p) } else #endif - if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width + if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width + /* When xdisp.c ignores FONT_HEIGHT, we cannot trust + font dimensions, since the actual glyphs might be + much smaller. So in that case we always clear the + rectangle with background color. */ + || FONT_TOO_HIGH (s->font) || s->font_not_found_p || s->extends_to_end_of_line_p || force_p) diff --git a/src/xdisp.c b/src/xdisp.c index a1b7cf1..ed430a4 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -25296,12 +25296,6 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row, } \ } -/* A heuristic test for fonts that claim they need a preposterously - large vertical space. The heuristics is in the factor of 3. We - ignore the ascent and descent values reported by such fonts, and - instead go by the values reported for individual glyphs. */ -#define FONT_TOO_HIGH(ft) ((ft)->ascent + (ft)->descent > 3*(ft)->pixel_size) - /* Store one glyph for IT->char_to_display in IT->glyph_row. Called from x_produce_glyphs when IT->glyph_row is non-null. */ @@ -26230,8 +26224,28 @@ produce_glyphless_glyph (struct it *it, bool for_no_font, Lisp_Object acronym) ASCII face. */ face = FACE_FROM_ID (it->f, it->face_id)->ascii_face; font = face->font ? face->font : FRAME_FONT (it->f); - it->ascent = FONT_BASE (font) + font->baseline_offset; - it->descent = FONT_DESCENT (font) - font->baseline_offset; + it->ascent = FONT_BASE (font); + it->descent = FONT_DESCENT (font); + /* Attempt to fix box height for fonts that claim preposterously + large height. */ + if (FONT_TOO_HIGH (font)) + { + XChar2b char2b; + + /* Get metrics of a reasonably sized ASCII character. */ + if (get_char_glyph_code ('{', font, &char2b)) + { + struct font_metrics *pcm = get_per_char_metric (font, &char2b); + + if (!(pcm->width == 0 && pcm->rbearing == 0 && pcm->lbearing == 0)) + { + it->ascent = pcm->ascent; + it->descent = pcm->descent; + } + } + } + it->ascent += font->baseline_offset; + it->descent -= font->baseline_offset; base_height = it->ascent + it->descent; base_width = font->average_width; diff --git a/src/xftfont.c b/src/xftfont.c index 0e8b876..a1846e8 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -617,8 +617,26 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y, XftDrawSetClip (xft_draw, NULL); if (with_background) - XftDrawRect (xft_draw, &bg, - x, y - s->font->ascent, s->width, s->font->height); + { + int height = FONT_HEIGHT (s->font), ascent = FONT_BASE (s->font); + + /* Font's global height and ascent values might be + preposterously large for some fonts. We fix here the case + when those fonts are used for display of glyphless + characters, because drawing background with font dimensions + in those cases makes the display illegible. There's only one + more call to the draw method with with_background set to + true, and that's in x_draw_glyph_string_foreground, when + drawing the cursor, where we have no such heuristics + available. FIXME. */ + if (s->first_glyph->type == GLYPHLESS_GLYPH + && (s->first_glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE + || s->first_glyph->u.glyphless.method == GLYPHLESS_DISPLAY_ACRONYM)) + height = ascent = + s->first_glyph->slice.glyphless.lower_yoff + - s->first_glyph->slice.glyphless.upper_yoff; + XftDrawRect (xft_draw, &bg, x, y - ascent, s->width, height); + } code = alloca (sizeof (FT_UInt) * len); for (i = 0; i < len; i++) code[i] = ((XCHAR2B_BYTE1 (s->char2b + from + i) << 8) diff --git a/src/xterm.c b/src/xterm.c index 4f5dfed..58563ff 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1724,6 +1724,11 @@ x_draw_glyph_string_background (struct glyph_string *s, bool force_p) s->background_filled_p = true; } else if (FONT_HEIGHT (s->font) < s->height - 2 * box_line_width + /* When xdisp.c ignores FONT_HEIGHT, we cannot trust + font dimensions, since the actual glyphs might be + much smaller. So in that case we always clear the + rectangle with background color. */ + || FONT_TOO_HIGH (s->font) || s->font_not_found_p || s->extends_to_end_of_line_p || force_p) commit 1d87cb3cfa08086be96f78ab09d99f3e7ba8ca60 Author: Eli Zaretskii Date: Wed May 27 17:56:16 2015 +0300 Avoid very high screen lines with some fonts * src/xdisp.c (get_phys_cursor_geometry): Adjust the height of the cursor to avoid weird-looking hollow cursor with fonts that have large ascent values for some glyphs. This avoids having the hollow cursor start too low. (append_space_for_newline): Adjust the ascent value of the newline glyph, so that the hollow cursor at end of line displays correctly. (FONT_TOO_HIGH): New macro. (x_produce_glyphs): Use it to detect fonts that claim a preposterously large height, in which case we use per-glyph ascent and descent values. (Bug#20628) diff --git a/src/xdisp.c b/src/xdisp.c index 87f110e..a1b7cf1 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -2150,7 +2150,7 @@ get_phys_cursor_geometry (struct window *w, struct glyph_row *row, struct glyph *glyph, int *xp, int *yp, int *heightp) { struct frame *f = XFRAME (WINDOW_FRAME (w)); - int x, y, wd, h, h0, y0; + int x, y, wd, h, h0, y0, ascent; /* Compute the width of the rectangle to draw. If on a stretch glyph, and `x-stretch-block-cursor' is nil, don't draw a @@ -2170,13 +2170,21 @@ get_phys_cursor_geometry (struct window *w, struct glyph_row *row, wd = min (FRAME_COLUMN_WIDTH (f), wd); w->phys_cursor_width = wd; - y = w->phys_cursor.y + row->ascent - glyph->ascent; + /* Don't let the hollow cursor glyph descend below the glyph row's + ascent value, lest the hollow cursor looks funny. */ + y = w->phys_cursor.y; + ascent = row->ascent; + if (row->ascent < glyph->ascent) + { + y =- glyph->ascent - row->ascent; + ascent = glyph->ascent; + } /* If y is below window bottom, ensure that we still see a cursor. */ h0 = min (FRAME_LINE_HEIGHT (f), row->visible_height); - h = max (h0, glyph->ascent + glyph->descent); - h0 = min (h0, glyph->ascent + glyph->descent); + h = max (h0, ascent + glyph->descent); + h0 = min (h0, ascent + glyph->descent); y0 = WINDOW_HEADER_LINE_HEIGHT (w); if (y < y0) @@ -19171,6 +19179,7 @@ append_space_for_newline (struct it *it, bool default_face_p) struct text_pos saved_pos; Lisp_Object saved_object; struct face *face; + struct glyph *g; saved_object = it->object; saved_pos = it->position; @@ -19202,6 +19211,11 @@ append_space_for_newline (struct it *it, bool default_face_p) PRODUCE_GLYPHS (it); + /* Make sure this space glyph has the right ascent value, or + else hollow cursor at end of line will look funny. */ + g = it->glyph_row->glyphs[TEXT_AREA] + n; + g->ascent = it->glyph_row->ascent; + it->override_ascent = -1; it->constrain_row_ascent_descent_p = false; it->current_x = saved_x; @@ -25282,6 +25296,12 @@ draw_glyphs (struct window *w, int x, struct glyph_row *row, } \ } +/* A heuristic test for fonts that claim they need a preposterously + large vertical space. The heuristics is in the factor of 3. We + ignore the ascent and descent values reported by such fonts, and + instead go by the values reported for individual glyphs. */ +#define FONT_TOO_HIGH(ft) ((ft)->ascent + (ft)->descent > 3*(ft)->pixel_size) + /* Store one glyph for IT->char_to_display in IT->glyph_row. Called from x_produce_glyphs when IT->glyph_row is non-null. */ @@ -26398,6 +26418,22 @@ x_produce_glyphs (struct it *it) it->phys_ascent = pcm->ascent + boff; it->phys_descent = pcm->descent - boff; it->pixel_width = pcm->width; + /* Don't use font-global values for ascent and descent + if they result in an exceedingly large line height. */ + if (it->override_ascent < 0) + { + if (FONT_TOO_HIGH (font)) + { + it->ascent = it->phys_ascent; + it->descent = it->phys_descent; + /* These limitations are enforced by an + assertion near the end of this function. */ + if (it->ascent < 0) + it->ascent = 0; + if (it->descent < 0) + it->descent = 0; + } + } } else { @@ -26525,8 +26561,18 @@ x_produce_glyphs (struct it *it) } else { - it->ascent = FONT_BASE (font) + boff; - it->descent = FONT_DESCENT (font) - boff; + if (FONT_TOO_HIGH (font)) + { + it->ascent = font->pixel_size + boff - 1; + it->descent = -boff + 1; + if (it->descent < 0) + it->descent = 0; + } + else + { + it->ascent = FONT_BASE (font) + boff; + it->descent = FONT_DESCENT (font) - boff; + } } if (EQ (height, Qt)) @@ -26597,8 +26643,38 @@ x_produce_glyphs (struct it *it) it->pixel_width = next_tab_x - x; it->nglyphs = 1; - it->ascent = it->phys_ascent = FONT_BASE (font) + boff; - it->descent = it->phys_descent = FONT_DESCENT (font) - boff; + if (FONT_TOO_HIGH (font)) + { + if (get_char_glyph_code (' ', font, &char2b)) + { + pcm = get_per_char_metric (font, &char2b); + if (pcm->width == 0 + && pcm->rbearing == 0 && pcm->lbearing == 0) + pcm = NULL; + } + + if (pcm) + { + it->ascent = pcm->ascent + boff; + it->descent = pcm->descent - boff; + } + else + { + it->ascent = font->pixel_size + boff - 1; + it->descent = -boff + 1; + } + if (it->ascent < 0) + it->ascent = 0; + if (it->descent < 0) + it->descent = 0; + } + else + { + it->ascent = FONT_BASE (font) + boff; + it->descent = FONT_DESCENT (font) - boff; + } + it->phys_ascent = it->ascent; + it->phys_descent = it->descent; if (it->glyph_row) {