commit acac9f4d727072b31914c9224957ff8dfec97df1 (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Thu Aug 13 17:05:44 2015 -0400 * lisp/progmodes/sh-script.el (sh-mode): Handle .cshrc (bug#21049) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 6709e75..735c8f9 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1675,7 +1675,7 @@ with your script for an edit-interpret-debug cycle." ((string-match "[.]sh\\>" buffer-file-name) "sh") ((string-match "[.]bash\\>" buffer-file-name) "bash") ((string-match "[.]ksh\\>" buffer-file-name) "ksh") - ((string-match "[.]csh\\>" buffer-file-name) "csh") + ((string-match "[.]t?csh\\(rc\\)?\\>" buffer-file-name) "csh") ((equal (file-name-nondirectory buffer-file-name) ".profile") "sh") (t sh-shell-file)) nil nil) commit c24e742e00775a3e6964f32a521460345c9e07cb Author: Magnus Henoch Date: Thu Aug 13 16:59:16 2015 -0400 * lisp/progmodes/compile.el: Assume 8-wide TABs (bug#21038) * lisp/progmodes/compile.el: Use lexical-binding. (compilation-move-to-column): Assume 8-wide TABs (bug#21038). diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 9a44335..9d1d148 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1,4 +1,4 @@ -;;; compile.el --- run compiler as inferior of Emacs, parse error messages +;;; compile.el --- run compiler as inferior of Emacs, parse error messages -*- lexical-binding:t -*- ;; Copyright (C) 1985-1987, 1993-1999, 2001-2015 Free Software ;; Foundation, Inc. @@ -1109,7 +1109,9 @@ If SCREEN is non-nil, columns are screen columns, otherwise, they are just char-counts." (setq col (- col compilation-first-column)) (if screen - (move-to-column (max col 0)) + ;; Presumably, the compilation tool doesn't know about our current + ;; `tab-width' setting, so it probably assumed 8-wide TABs (bug#21038). + (let ((tab-width 8)) (move-to-column (max col 0))) (goto-char (min (+ (line-beginning-position) col) (line-end-position))))) (defun compilation-internal-error-properties (file line end-line col end-col type fmts) commit 0319f122def8890266f7462bd55ec0bc31045d97 Author: Stefan Monnier Date: Thu Aug 13 16:53:49 2015 -0400 (uniquify-ask-about-buffer-names-p): Remove, unused (bug#21037) * lisp/uniquify.el: Remove redundant `:group's. diff --git a/lisp/uniquify.el b/lisp/uniquify.el index ce681b4..c5692ff 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -116,20 +116,11 @@ you can set, browse the `uniquify' custom group." (const post-forward-angle-brackets) (const :tag "numeric suffixes" nil)) :version "24.4" - :require 'uniquify - :group 'uniquify) + :require 'uniquify) (defcustom uniquify-after-kill-buffer-p t "If non-nil, rerationalize buffer names after a buffer has been killed." - :type 'boolean - :group 'uniquify) - -(defcustom uniquify-ask-about-buffer-names-p nil - "If non-nil, permit user to choose names for buffers with same base file. -If the user chooses to name a buffer, uniquification is preempted and no -other buffer names are changed." - :type 'boolean - :group 'uniquify) + :type 'boolean) ;; The default value matches certain Gnus buffers. (defcustom uniquify-ignore-buffers-re nil @@ -137,13 +128,11 @@ other buffer names are changed." For instance, set this to \"^draft-[0-9]+$\" to avoid having uniquify rename draft buffers even if `uniquify-after-kill-buffer-p' is non-nil and the visited file name isn't the same as that of the buffer." - :type '(choice (const :tag "Uniquify all buffers" nil) regexp) - :group 'uniquify) + :type '(choice (const :tag "Uniquify all buffers" nil) regexp)) (defcustom uniquify-min-dir-content 0 "Minimum number of directory name components included in buffer name." - :type 'integer - :group 'uniquify) + :type 'integer) (defcustom uniquify-separator nil "String separator for buffer name components. @@ -151,16 +140,14 @@ When `uniquify-buffer-name-style' is `post-forward', separates base file name from directory part in buffer names (default \"|\"). When `uniquify-buffer-name-style' is `reverse', separates all file name components (default \"\\\")." - :type '(choice (const nil) string) - :group 'uniquify) + :type '(choice (const nil) string)) (defcustom uniquify-trailing-separator-p nil "If non-nil, add a file name separator to dired buffer names. If `uniquify-buffer-name-style' is `forward', add the separator at the end; if it is `reverse', add the separator at the beginning; otherwise, this variable is ignored." - :type 'boolean - :group 'uniquify) + :type 'boolean) (defcustom uniquify-strip-common-suffix ;; Using it when uniquify-min-dir-content>0 doesn't make much sense. @@ -169,8 +156,7 @@ variable is ignored." E.g. if you open /a1/b/c/d and /a2/b/c/d, the buffer names will say \"d|a1\" and \"d|a2\" instead of \"d|a1/b/c\" and \"d|a2/b/c\". This can be handy when you have deep parallel hierarchies." - :type 'boolean - :group 'uniquify) + :type 'boolean) (defvar uniquify-list-buffers-directory-modes '(dired-mode cvs-mode vc-dir-mode) "List of modes for which uniquify should obey `list-buffers-directory'. commit fbee6265a72a4129d2efbf15a622b13e8b4aae9f Author: Paul Eggert Date: Thu Aug 13 13:48:28 2015 -0700 Make add_to_log varargs * src/alloc.c (run_finalizer_handler): * src/charset.c (load_charset_map_from_vector): * src/nsimage.m (ns_load_image): * src/xfaces.c (load_pixmap, load_color2): Simplify, now that add_to_log has a variable number of args. * src/image.c (image_error): Take a variable number of args. Callers simplified. * src/lisp.h (add_to_log, vadd_to_log): Adjust to new APIs. * src/xdisp.c (format_nargs, vadd_to_log): New functions. (add_to_log): Make varargs, and reimplement in terms of vadd_to_log. * src/xfaces.c (merge_face_ref): Fix typo that omitted color name. diff --git a/src/alloc.c b/src/alloc.c index 050097c..66e62da 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3765,7 +3765,7 @@ queue_doomed_finalizers (struct Lisp_Finalizer *dest, static Lisp_Object run_finalizer_handler (Lisp_Object args) { - add_to_log ("finalizer failed: %S", args, Qnil); + add_to_log ("finalizer failed: %S", args); return Qnil; } diff --git a/src/charset.c b/src/charset.c index b19e344..eeebf17 100644 --- a/src/charset.c +++ b/src/charset.c @@ -555,7 +555,7 @@ load_charset_map_from_vector (struct charset *charset, Lisp_Object vec, int cont if (len % 2 == 1) { - add_to_log ("Failure in loading charset map: %V", vec, Qnil); + add_to_log ("Failure in loading charset map: %V", vec); return; } diff --git a/src/image.c b/src/image.c index 066db74..313419b 100644 --- a/src/image.c +++ b/src/image.c @@ -629,16 +629,19 @@ valid_image_p (Lisp_Object object) } -/* Log error message with format string FORMAT and argument ARG. +/* Log error message with format string FORMAT and trailing arguments. Signaling an error, e.g. when an image cannot be loaded, is not a good idea because this would interrupt redisplay, and the error message display would lead to another redisplay. This function therefore simply displays a message. */ static void -image_error (const char *format, Lisp_Object arg1, Lisp_Object arg2) +image_error (const char *format, ...) { - add_to_log (format, arg1, arg2); + va_list ap; + va_start (ap, format); + vadd_to_log (format, ap); + va_end (ap); } @@ -1954,7 +1957,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, depth > 16 ? 32 : depth > 8 ? 16 : 8, 0); if (*ximg == NULL) { - image_error ("Unable to allocate X image", Qnil, Qnil); + image_error ("Unable to allocate X image"); return 0; } @@ -1976,7 +1979,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, { x_destroy_x_image (*ximg); *ximg = NULL; - image_error ("Unable to create X pixmap", Qnil, Qnil); + image_error ("Unable to create X pixmap"); return 0; } @@ -1997,7 +2000,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, if (depth != 1 && depth != 4 && depth != 8 && depth != 16 && depth != 24 && depth != 32) { - image_error ("Invalid image bit depth specified", Qnil, Qnil); + image_error ("Invalid image bit depth specified"); return 0; } @@ -2055,7 +2058,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, Lisp_Object errcode; /* All system errors are < 10000, so the following is safe. */ XSETINT (errcode, err); - image_error ("Unable to create bitmap, error code %d", errcode, Qnil); + image_error ("Unable to create bitmap, error code %d", errcode); x_destroy_x_image (*ximg); *ximg = NULL; return 0; @@ -2070,7 +2073,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, if (*pixmap == 0) { *ximg = NULL; - image_error ("Unable to allocate NSImage for XPM pixmap", Qnil, Qnil); + image_error ("Unable to allocate NSImage for XPM pixmap"); return 0; } *ximg = *pixmap; @@ -2791,7 +2794,7 @@ xbm_read_bitmap_data (struct frame *f, unsigned char *contents, unsigned char *e if (!check_image_size (f, *width, *height)) { if (!inhibit_image_error) - image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); + image_error ("Invalid image size (see `max-image-size')"); goto failure; } else if (data == NULL) @@ -2936,13 +2939,13 @@ xbm_load_image (struct frame *f, struct image *img, unsigned char *contents, if (img->pixmap == NO_PIXMAP) { x_clear_image (f, img); - image_error ("Unable to create X pixmap for `%s'", img->spec, Qnil); + image_error ("Unable to create X pixmap for `%s'", img->spec); } else success_p = 1; } else - image_error ("Error loading XBM image `%s'", img->spec, Qnil); + image_error ("Error loading XBM image `%s'", img->spec); return success_p; } @@ -2983,14 +2986,14 @@ xbm_load (struct frame *f, struct image *img) file = x_find_image_file (file_name); if (!STRINGP (file)) { - image_error ("Cannot find image file `%s'", file_name, Qnil); + image_error ("Cannot find image file `%s'", file_name); return 0; } contents = slurp_file (SSDATA (file), &size); if (contents == NULL) { - image_error ("Error loading XBM image `%s'", img->spec, Qnil); + image_error ("Error loading XBM image `%s'", img->spec); return 0; } @@ -3025,8 +3028,7 @@ xbm_load (struct frame *f, struct image *img) eassert (img->width > 0 && img->height > 0); if (!check_image_size (f, img->width, img->height)) { - image_error ("Invalid image size (see `max-image-size')", - Qnil, Qnil); + image_error ("Invalid image size (see `max-image-size')"); return 0; } } @@ -3104,7 +3106,7 @@ xbm_load (struct frame *f, struct image *img) else { image_error ("Unable to create pixmap for XBM image `%s'", - img->spec, Qnil); + img->spec); x_clear_image (f, img); } @@ -3626,7 +3628,7 @@ xpm_load (struct frame *f, struct image *img) Lisp_Object file = x_find_image_file (specified_file); if (!STRINGP (file)) { - image_error ("Cannot find image file `%s'", specified_file, Qnil); + image_error ("Cannot find image file `%s'", specified_file); #ifdef ALLOC_XPM_COLORS xpm_free_color_cache (); #endif @@ -3657,7 +3659,7 @@ xpm_load (struct frame *f, struct image *img) Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL); if (!STRINGP (buffer)) { - image_error ("Invalid image data `%s'", buffer, Qnil); + image_error ("Invalid image data `%s'", buffer); #ifdef ALLOC_XPM_COLORS xpm_free_color_cache (); #endif @@ -3815,23 +3817,23 @@ xpm_load (struct frame *f, struct image *img) switch (rc) { case XpmOpenFailed: - image_error ("Error opening XPM file (%s)", img->spec, Qnil); + image_error ("Error opening XPM file (%s)", img->spec); break; case XpmFileInvalid: - image_error ("Invalid XPM file (%s)", img->spec, Qnil); + image_error ("Invalid XPM file (%s)", img->spec); break; case XpmNoMemory: - image_error ("Out of memory (%s)", img->spec, Qnil); + image_error ("Out of memory (%s)", img->spec); break; case XpmColorFailed: - image_error ("Color allocation error (%s)", img->spec, Qnil); + image_error ("Color allocation error (%s)", img->spec); break; default: - image_error ("Unknown error (%s)", img->spec, Qnil); + image_error ("Unknown error (%s)", img->spec); break; } } @@ -4101,7 +4103,7 @@ xpm_load_image (struct frame *f, if (!check_image_size (f, width, height)) { - image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); + image_error ("Invalid image size (see `max-image-size')"); goto failure; } @@ -4112,7 +4114,7 @@ xpm_load_image (struct frame *f, #endif ) { - image_error ("Image too large", Qnil, Qnil); + image_error ("Image too large"); goto failure; } @@ -4262,7 +4264,7 @@ xpm_load_image (struct frame *f, return 1; failure: - image_error ("Invalid XPM file (%s)", img->spec, Qnil); + image_error ("Invalid XPM file (%s)", img->spec); x_destroy_x_image (ximg); x_destroy_x_image (mask_img); x_clear_image (f, img); @@ -4291,14 +4293,14 @@ xpm_load (struct frame *f, file = x_find_image_file (file_name); if (!STRINGP (file)) { - image_error ("Cannot find image file `%s'", file_name, Qnil); + image_error ("Cannot find image file `%s'", file_name); return 0; } contents = slurp_file (SSDATA (file), &size); if (contents == NULL) { - image_error ("Error loading XPM image `%s'", img->spec, Qnil); + image_error ("Error loading XPM image `%s'", img->spec); return 0; } @@ -4312,7 +4314,7 @@ xpm_load (struct frame *f, data = image_spec_value (img->spec, QCdata, NULL); if (!STRINGP (data)) { - image_error ("Invalid image data `%s'", data, Qnil); + image_error ("Invalid image data `%s'", data); return 0; } success_p = xpm_load_image (f, img, SDATA (data), @@ -4734,7 +4736,7 @@ XPutPixel (XImagePtr ximg, int x, int y, COLORREF color) *pixel = *pixel & ~(1 << x % 8); } else - image_error ("XPutPixel: palette image not supported", Qnil, Qnil); + image_error ("XPutPixel: palette image not supported"); } #endif /* HAVE_NTGUI */ @@ -5266,14 +5268,14 @@ pbm_load (struct frame *f, struct image *img) file = x_find_image_file (specified_file); if (!STRINGP (file)) { - image_error ("Cannot find image file `%s'", specified_file, Qnil); + image_error ("Cannot find image file `%s'", specified_file); return 0; } contents = slurp_file (SSDATA (file), &size); if (contents == NULL) { - image_error ("Error reading `%s'", file, Qnil); + image_error ("Error reading `%s'", file); return 0; } @@ -5286,7 +5288,7 @@ pbm_load (struct frame *f, struct image *img) data = image_spec_value (img->spec, QCdata, NULL); if (!STRINGP (data)) { - image_error ("Invalid image data `%s'", data, Qnil); + image_error ("Invalid image data `%s'", data); return 0; } p = SDATA (data); @@ -5296,7 +5298,7 @@ pbm_load (struct frame *f, struct image *img) /* Check magic number. */ if (end - p < 2 || *p++ != 'P') { - image_error ("Not a PBM image: `%s'", img->spec, Qnil); + image_error ("Not a PBM image: `%s'", img->spec); error: xfree (contents); img->pixmap = NO_PIXMAP; @@ -5330,7 +5332,7 @@ pbm_load (struct frame *f, struct image *img) break; default: - image_error ("Not a PBM image: `%s'", img->spec, Qnil); + image_error ("Not a PBM image: `%s'", img->spec); goto error; } @@ -5349,14 +5351,14 @@ pbm_load (struct frame *f, struct image *img) max_color_idx = pbm_scan_number (&p, end); if (max_color_idx > 65535 || max_color_idx < 0) { - image_error ("Unsupported maximum PBM color value", Qnil, Qnil); + image_error ("Unsupported maximum PBM color value"); goto error; } } if (!check_image_size (f, width, height)) { - image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); + image_error ("Invalid image size (see `max-image-size')"); goto error; } @@ -5430,7 +5432,7 @@ pbm_load (struct frame *f, struct image *img) #endif x_clear_image (f, img); image_error ("Invalid image size in image `%s'", - img->spec, Qnil); + img->spec); goto error; } c = *p++; @@ -5465,7 +5467,7 @@ pbm_load (struct frame *f, struct image *img) #endif x_clear_image (f, img); image_error ("Invalid image size in image `%s'", - img->spec, Qnil); + img->spec); goto error; } @@ -5509,7 +5511,7 @@ pbm_load (struct frame *f, struct image *img) x_destroy_x_image (ximg); #endif image_error ("Invalid pixel value in image `%s'", - img->spec, Qnil); + img->spec); goto error; } @@ -5800,7 +5802,7 @@ my_png_error (png_struct *png_ptr, const char *msg) eassert (png_ptr != NULL); /* Avoid compiler warning about deprecated direct access to png_ptr's fields in libpng versions 1.4.x. */ - image_error ("PNG error: %s", build_string (msg), Qnil); + image_error ("PNG error: %s", build_string (msg)); PNG_LONGJMP (png_ptr); } @@ -5809,7 +5811,7 @@ static void my_png_warning (png_struct *png_ptr, const char *msg) { eassert (png_ptr != NULL); - image_error ("PNG warning: %s", build_string (msg), Qnil); + image_error ("PNG warning: %s", build_string (msg)); } /* Memory source for PNG decoding. */ @@ -5904,7 +5906,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) file = x_find_image_file (specified_file); if (!STRINGP (file)) { - image_error ("Cannot find image file `%s'", specified_file, Qnil); + image_error ("Cannot find image file `%s'", specified_file); return 0; } @@ -5912,7 +5914,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) fp = emacs_fopen (SSDATA (file), "rb"); if (!fp) { - image_error ("Cannot open image file `%s'", file, Qnil); + image_error ("Cannot open image file `%s'", file); return 0; } @@ -5921,7 +5923,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) || png_sig_cmp (sig, 0, sizeof sig)) { fclose (fp); - image_error ("Not a PNG file: `%s'", file, Qnil); + image_error ("Not a PNG file: `%s'", file); return 0; } } @@ -5929,7 +5931,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) { if (!STRINGP (specified_data)) { - image_error ("Invalid image data `%s'", specified_data, Qnil); + image_error ("Invalid image data `%s'", specified_data); return 0; } @@ -5942,7 +5944,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) if (tbr.len < sizeof sig || png_sig_cmp (tbr.bytes, 0, sizeof sig)) { - image_error ("Not a PNG image: `%s'", img->spec, Qnil); + image_error ("Not a PNG image: `%s'", img->spec); return 0; } @@ -6010,7 +6012,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) if (! (width <= INT_MAX && height <= INT_MAX && check_image_size (f, width, height))) { - image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); + image_error ("Invalid image size (see `max-image-size')"); goto error; } @@ -6668,20 +6670,20 @@ jpeg_load_body (struct frame *f, struct image *img, file = x_find_image_file (specified_file); if (!STRINGP (file)) { - image_error ("Cannot find image file `%s'", specified_file, Qnil); + image_error ("Cannot find image file `%s'", specified_file); return 0; } fp = emacs_fopen (SSDATA (file), "rb"); if (fp == NULL) { - image_error ("Cannot open `%s'", file, Qnil); + image_error ("Cannot open `%s'", file); return 0; } } else if (!STRINGP (specified_data)) { - image_error ("Invalid image data `%s'", specified_data, Qnil); + image_error ("Invalid image data `%s'", specified_data); return 0; } @@ -6703,7 +6705,7 @@ jpeg_load_body (struct frame *f, struct image *img, } case MY_JPEG_INVALID_IMAGE_SIZE: - image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); + image_error ("Invalid image size (see `max-image-size')"); break; case MY_JPEG_CANNOT_CREATE_X: @@ -7183,7 +7185,7 @@ tiff_load (struct frame *f, struct image *img) file = x_find_image_file (specified_file); if (!STRINGP (file)) { - image_error ("Cannot find image file `%s'", specified_file, Qnil); + image_error ("Cannot find image file `%s'", specified_file); return 0; } # ifdef WINDOWSNT @@ -7194,7 +7196,7 @@ tiff_load (struct frame *f, struct image *img) tiff = TIFFOpen (SSDATA (file), "r"); if (tiff == NULL) { - image_error ("Cannot open `%s'", file, Qnil); + image_error ("Cannot open `%s'", file); return 0; } } @@ -7202,7 +7204,7 @@ tiff_load (struct frame *f, struct image *img) { if (!STRINGP (specified_data)) { - image_error ("Invalid image data `%s'", specified_data, Qnil); + image_error ("Invalid image data `%s'", specified_data); return 0; } @@ -7222,7 +7224,7 @@ tiff_load (struct frame *f, struct image *img) if (!tiff) { - image_error ("Cannot open memory source for `%s'", img->spec, Qnil); + image_error ("Cannot open memory source for `%s'", img->spec); return 0; } } @@ -7248,7 +7250,7 @@ tiff_load (struct frame *f, struct image *img) if (!check_image_size (f, width, height)) { - image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); + image_error ("Invalid image size (see `max-image-size')"); TIFFClose (tiff); return 0; } @@ -7278,7 +7280,7 @@ tiff_load (struct frame *f, struct image *img) TIFFClose (tiff); if (!rc) { - image_error ("Error reading TIFF image `%s'", img->spec, Qnil); + image_error ("Error reading TIFF image `%s'", img->spec); xfree (buf); return 0; } @@ -7615,7 +7617,7 @@ gif_load (struct frame *f, struct image *img) file = x_find_image_file (specified_file); if (!STRINGP (file)) { - image_error ("Cannot find image file `%s'", specified_file, Qnil); + image_error ("Cannot find image file `%s'", specified_file); return 0; } #ifdef WINDOWSNT @@ -7627,7 +7629,7 @@ gif_load (struct frame *f, struct image *img) gif = DGifOpenFileName (SSDATA (file)); if (gif == NULL) { - image_error ("Cannot open `%s'", file, Qnil); + image_error ("Cannot open `%s'", file); return 0; } #else @@ -7644,7 +7646,7 @@ gif_load (struct frame *f, struct image *img) { if (!STRINGP (specified_data)) { - image_error ("Invalid image data `%s'", specified_data, Qnil); + image_error ("Invalid image data `%s'", specified_data); return 0; } @@ -7658,7 +7660,7 @@ gif_load (struct frame *f, struct image *img) gif = DGifOpen (&memsrc, gif_read_from_memory); if (!gif) { - image_error ("Cannot open memory source `%s'", img->spec, Qnil); + image_error ("Cannot open memory source `%s'", img->spec); return 0; } #else @@ -7675,7 +7677,7 @@ gif_load (struct frame *f, struct image *img) /* Before reading entire contents, check the declared image size. */ if (!check_image_size (f, gif->SWidth, gif->SHeight)) { - image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); + image_error ("Invalid image size (see `max-image-size')"); gif_close (gif, NULL); return 0; } @@ -7684,7 +7686,7 @@ gif_load (struct frame *f, struct image *img) rc = DGifSlurp (gif); if (rc == GIF_ERROR || gif->ImageCount <= 0) { - image_error ("Error reading `%s'", img->spec, Qnil); + image_error ("Error reading `%s'", img->spec); gif_close (gif, NULL); return 0; } @@ -7714,7 +7716,7 @@ gif_load (struct frame *f, struct image *img) if (!check_image_size (f, width, height)) { - image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); + image_error ("Invalid image size (see `max-image-size')"); gif_close (gif, NULL); return 0; } @@ -7732,7 +7734,7 @@ gif_load (struct frame *f, struct image *img) && 0 <= subimg_top && subimg_top <= height - subimg_height && 0 <= subimg_left && subimg_left <= width - subimg_width)) { - image_error ("Subimage does not fit in image", Qnil, Qnil); + image_error ("Subimage does not fit in image"); gif_close (gif, NULL); return 0; } @@ -7971,7 +7973,7 @@ gif_load (struct frame *f, struct image *img) image_error ("Error closing `%s': %s", img->spec, build_string (error_text)); #else - image_error ("Error closing `%s'", img->spec, Qnil); + image_error ("Error closing `%s'", img->spec); #endif } @@ -8220,9 +8222,7 @@ imagemagick_error (MagickWand *wand) ExceptionType severity; description = MagickGetException (wand, &severity); - image_error ("ImageMagick error: %s", - build_string (description), - Qnil); + image_error ("ImageMagick error: %s", build_string (description)); MagickRelinquishMemory (description); } @@ -8383,8 +8383,7 @@ imagemagick_compute_animated_image (MagickWand *super_wand, int ino) DestroyMagickWand (composite_wand); DestroyMagickWand (sub_wand); cache->wand = NULL; - image_error ("Imagemagick pixel iterator creation failed", - Qnil, Qnil); + image_error ("Imagemagick pixel iterator creation failed"); return NULL; } @@ -8395,8 +8394,7 @@ imagemagick_compute_animated_image (MagickWand *super_wand, int ino) DestroyMagickWand (sub_wand); DestroyPixelIterator (source_iterator); cache->wand = NULL; - image_error ("Imagemagick pixel iterator creation failed", - Qnil, Qnil); + image_error ("Imagemagick pixel iterator creation failed"); return NULL; } @@ -8571,7 +8569,7 @@ imagemagick_load_image (struct frame *f, struct image *img, status = MagickScaleImage (image_wand, desired_width, desired_height); if (status == MagickFalse) { - image_error ("Imagemagick scale failed", Qnil, Qnil); + image_error ("Imagemagick scale failed"); imagemagick_error (image_wand); goto imagemagick_error; } @@ -8621,7 +8619,7 @@ imagemagick_load_image (struct frame *f, struct image *img, status = MagickRotateImage (image_wand, bg_wand, rotation); if (status == MagickFalse) { - image_error ("Imagemagick image rotate failed", Qnil, Qnil); + image_error ("Imagemagick image rotate failed"); imagemagick_error (image_wand); goto imagemagick_error; } @@ -8651,7 +8649,7 @@ imagemagick_load_image (struct frame *f, struct image *img, if (! (image_width <= INT_MAX && image_height <= INT_MAX && check_image_size (f, image_width, image_height))) { - image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); + image_error ("Invalid image size (see `max-image-size')"); goto imagemagick_error; } @@ -8678,7 +8676,7 @@ imagemagick_load_image (struct frame *f, struct image *img, #ifdef COLOR_TABLE_SUPPORT free_color_table (); #endif - image_error ("Imagemagick X bitmap allocation failure", Qnil, Qnil); + image_error ("Imagemagick X bitmap allocation failure"); goto imagemagick_error; } @@ -8718,7 +8716,7 @@ imagemagick_load_image (struct frame *f, struct image *img, #ifdef COLOR_TABLE_SUPPORT free_color_table (); #endif - image_error ("Imagemagick X bitmap allocation failure", Qnil, Qnil); + image_error ("Imagemagick X bitmap allocation failure"); goto imagemagick_error; } @@ -8734,8 +8732,7 @@ imagemagick_load_image (struct frame *f, struct image *img, free_color_table (); #endif x_destroy_x_image (ximg); - image_error ("Imagemagick pixel iterator creation failed", - Qnil, Qnil); + image_error ("Imagemagick pixel iterator creation failed"); goto imagemagick_error; } @@ -8787,7 +8784,7 @@ imagemagick_load_image (struct frame *f, struct image *img, MagickWandTerminus (); /* TODO more cleanup. */ - image_error ("Error parsing IMAGEMAGICK image `%s'", img->spec, Qnil); + image_error ("Error parsing IMAGEMAGICK image `%s'", img->spec); return 0; } @@ -8811,7 +8808,7 @@ imagemagick_load (struct frame *f, struct image *img) file = x_find_image_file (file_name); if (!STRINGP (file)) { - image_error ("Cannot find image file `%s'", file_name, Qnil); + image_error ("Cannot find image file `%s'", file_name); return 0; } #ifdef WINDOWSNT @@ -8828,7 +8825,7 @@ imagemagick_load (struct frame *f, struct image *img) data = image_spec_value (img->spec, QCdata, NULL); if (!STRINGP (data)) { - image_error ("Invalid image data `%s'", data, Qnil); + image_error ("Invalid image data `%s'", data); return 0; } success_p = imagemagick_load_image (f, img, SDATA (data), @@ -9092,7 +9089,7 @@ svg_load (struct frame *f, struct image *img) file = x_find_image_file (file_name); if (!STRINGP (file)) { - image_error ("Cannot find image file `%s'", file_name, Qnil); + image_error ("Cannot find image file `%s'", file_name); return 0; } @@ -9100,7 +9097,7 @@ svg_load (struct frame *f, struct image *img) contents = slurp_file (SSDATA (file), &size); if (contents == NULL) { - image_error ("Error loading SVG image `%s'", img->spec, Qnil); + image_error ("Error loading SVG image `%s'", img->spec); return 0; } /* If the file was slurped into memory properly, parse it. */ @@ -9116,7 +9113,7 @@ svg_load (struct frame *f, struct image *img) data = image_spec_value (img->spec, QCdata, NULL); if (!STRINGP (data)) { - image_error ("Invalid image data `%s'", data, Qnil); + image_error ("Invalid image data `%s'", data); return 0; } original_filename = BVAR (current_buffer, filename); @@ -9183,7 +9180,7 @@ svg_load_image (struct frame *f, /* Pointer to emacs frame structure. * rsvg_handle_get_dimensions (rsvg_handle, &dimension_data); if (! check_image_size (f, dimension_data.width, dimension_data.height)) { - image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); + image_error ("Invalid image size (see `max-image-size')"); goto rsvg_error; } @@ -9315,7 +9312,7 @@ svg_load_image (struct frame *f, /* Pointer to emacs frame structure. * g_object_unref (rsvg_handle); /* FIXME: Use error->message so the user knows what is the actual problem with the image. */ - image_error ("Error parsing SVG image `%s'", img->spec, Qnil); + image_error ("Error parsing SVG image `%s'", img->spec); g_error_free (err); return 0; } @@ -9468,7 +9465,7 @@ gs_load (struct frame *f, struct image *img) if (! (in_width <= INT_MAX && in_height <= INT_MAX && check_image_size (f, in_width, in_height))) { - image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); + image_error ("Invalid image size (see `max-image-size')"); return 0; } img->width = in_width; @@ -9489,7 +9486,7 @@ gs_load (struct frame *f, struct image *img) if (!img->pixmap) { - image_error ("Unable to create pixmap for `%s'", img->spec, Qnil); + image_error ("Unable to create pixmap for `%s'", img->spec); return 0; } @@ -9602,7 +9599,7 @@ x_kill_gs_process (Pixmap pixmap, struct frame *f) } else image_error ("Cannot get X image of `%s'; colors will not be freed", - img->spec, Qnil); + img->spec); unblock_input (); } diff --git a/src/lisp.h b/src/lisp.h index 02109d7..2545203 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3667,7 +3667,8 @@ extern Lisp_Object sit_for (Lisp_Object, bool, int); /* Defined in xdisp.c. */ extern bool noninteractive_need_newline; extern Lisp_Object echo_area_buffer[2]; -extern void add_to_log (const char *, Lisp_Object, Lisp_Object); +extern void add_to_log (char const *, ...); +extern void vadd_to_log (char const *, va_list); extern void check_message_stack (void); extern void setup_echo_area_for_printing (bool); extern bool push_message (void); diff --git a/src/nsimage.m b/src/nsimage.m index 9302cd2..13e8504 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -102,7 +102,7 @@ ns_load_image (struct frame *f, struct image *img, if (eImg == nil) { - add_to_log ("Unable to load image %s", img->spec, Qnil); + add_to_log ("Unable to load image %s", img->spec); return 0; } diff --git a/src/xdisp.c b/src/xdisp.c index 9b76174..52c77bd 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -9797,27 +9797,50 @@ include the height of both, if present, in the return value. */) Messages ***********************************************************************/ +/* Return the number of arguments the format string FORMAT needs. */ -/* Add a message with format string FORMAT and arguments ARG1 and ARG2 +static ptrdiff_t +format_nargs (char const *format) +{ + ptrdiff_t nargs = 0; + for (char const *p = format; (p = strchr (p, '%')); p++) + if (p[1] == '%') + p++; + else + nargs++; + return nargs; +} + +/* Add a message with format string FORMAT and formatted arguments to *Messages*. */ void -add_to_log (const char *format, Lisp_Object arg1, Lisp_Object arg2) +add_to_log (const char *format, ...) { - Lisp_Object msg, fmt; - char *buffer; - ptrdiff_t len; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - USE_SAFE_ALLOCA; - - fmt = msg = Qnil; - GCPRO4 (fmt, msg, arg1, arg2); + va_list ap; + va_start (ap, format); + vadd_to_log (format, ap); + va_end (ap); +} - fmt = build_string (format); - msg = CALLN (Fformat, fmt, arg1, arg2); +void +vadd_to_log (char const *format, va_list ap) +{ + ptrdiff_t nargs = 1 + format_nargs (format); + Lisp_Object args[10]; + eassert (nargs <= ARRAYELTS (args)); + args[0] = build_string (format); + for (ptrdiff_t i = 1; i <= nargs; i++) + args[i] = va_arg (ap, Lisp_Object); + Lisp_Object msg = Qnil; + struct gcpro gcpro1, gcpro2; + GCPRO2 (args, msg); + gcpro1.nvars = nargs; + msg = Fformat (nargs, args); - len = SBYTES (msg) + 1; - buffer = SAFE_ALLOCA (len); + ptrdiff_t len = SBYTES (msg) + 1; + USE_SAFE_ALLOCA; + char *buffer = SAFE_ALLOCA (len); memcpy (buffer, SDATA (msg), len); message_dolog (buffer, len - 1, true, false); diff --git a/src/xfaces.c b/src/xfaces.c index f0b6d39..ce300e7 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -797,7 +797,7 @@ load_pixmap (struct frame *f, Lisp_Object name) if (bitmap_id < 0) { - add_to_log ("Invalid or undefined bitmap `%s'", name, Qnil); + add_to_log ("Invalid or undefined bitmap `%s'", name); bitmap_id = 0; } else @@ -1099,7 +1099,7 @@ load_color2 (struct frame *f, struct face *face, Lisp_Object name, to the values in an existing cell. */ if (!defined_color (f, SSDATA (name), color, true)) { - add_to_log ("Unable to load color \"%s\"", name, Qnil); + add_to_log ("Unable to load color \"%s\"", name); switch (target_index) { @@ -2247,7 +2247,7 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, else { if (err_msgs) - add_to_log ("Invalid face color", color_name, Qnil); + add_to_log ("Invalid face color %S", color_name); ok = false; } } @@ -2452,7 +2452,7 @@ merge_face_ref (struct frame *f, Lisp_Object face_ref, Lisp_Object *to, /* FACE_REF ought to be a face name. */ ok = merge_named_face (f, face_ref, to, named_merge_points); if (!ok && err_msgs) - add_to_log ("Invalid face reference: %s", face_ref, Qnil); + add_to_log ("Invalid face reference: %s", face_ref); } return ok; commit b532875a6021cd1715321dda932b187522840944 Author: Paul Eggert Date: Thu Aug 13 12:16:25 2015 -0700 Optional args for holiday-greek-orthodox-easter * etc/NEWS: Document this. * lisp/calendar/holidays.el (holiday-greek-orthodox-easter): Add optional args N and STRING, mimicking the API and code of ‘holiday-easter-etc’. From suggestion by Foivos S. Zakkak (Bug#21256). diff --git a/etc/NEWS b/etc/NEWS index 0a33a6e..3ec16f5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -552,6 +552,9 @@ The option customizes which day headers receive the `calendar-weekend-header' face. --- +*** New optional args N and STRING for ‘holiday-greek-orthodox-easter’. + +--- *** Many items obsolete since at least version 23.1 have been removed. The majority were function/variable/face aliases, too numerous to list here. The remainder were: diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index 8085c1c..6d7cea6 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -791,8 +791,16 @@ is non-nil)." ;; Prior call to calendar-julian-from-absolute will autoload cal-julian. (declare-function calendar-julian-to-absolute "cal-julian" (date)) -(defun holiday-greek-orthodox-easter () - "Date of Easter according to the rule of the Council of Nicaea." +(defun holiday-greek-orthodox-easter (&optional n string) + "Date of Nth day after Easter (named STRING), if visible in calendar window. +It is calculated according to the rule of the Council of Nicaea. +Negative values of N are interpreted as days before Easter. +STRING is used purely for display purposes. The return value has +the form ((MONTH DAY YEAR) STRING), where the date is that of the +Nth day before or after Easter. + +For backwards compatibility, if this function is called with no +arguments, it returns the date of Pascha (Greek Orthodox Easter)." (let* ((m displayed-month) (y displayed-year) (julian-year (progn @@ -808,11 +816,10 @@ is non-nil)." (paschal-moon ; day after full moon on or after March 21 (- (calendar-julian-to-absolute (list 4 19 julian-year)) shifted-epact)) - (nicaean-easter ; Sunday following the Paschal moon - (calendar-gregorian-from-absolute - (calendar-dayname-on-or-before 0 (+ paschal-moon 7))))) - (if (calendar-date-is-visible-p nicaean-easter) - (list (list nicaean-easter "Pascha (Greek Orthodox Easter)"))))) + (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7))) + (greg (calendar-gregorian-from-absolute (+ abs-easter (or n 0))))) + (if (calendar-date-is-visible-p greg) + (list (list greg (or string "Pascha (Greek Orthodox Easter)")))))) (provide 'holidays) commit 57adf425f511b90153f128e7679b5f432df13fb5 Author: Jürgen Hötzel Date: Thu Aug 13 20:59:16 2015 +0200 ; Fix caching problem in tramp-adb.el * lisp/net/tramp-adb.el (tramp-adb-handle-directory-files-and-attributes): Make a copy of result to prevent modification of the tramp-cache by side effects. Use the correct cache key. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index d04d8f6..ca76f62 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -394,41 +394,42 @@ pass to the OPERATION." "Like `directory-files-and-attributes' for Tramp files." (when (file-directory-p directory) (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property - v localname (format "directory-files-attributes-%s-%s-%s-%s" - full match id-format nosort) - (with-current-buffer (tramp-get-buffer v) - (when (tramp-adb-send-command-and-check - v (format "%s -a -l %s" - (tramp-adb-get-ls-command v) - (tramp-shell-quote-argument localname))) - ;; We insert also filename/. and filename/.., because "ls" doesn't. - (narrow-to-region (point) (point)) - (tramp-adb-send-command - v (format "%s -d -a -l %s %s" - (tramp-adb-get-ls-command v) - (tramp-shell-quote-argument - (concat (file-name-as-directory localname) ".")) - (tramp-shell-quote-argument - (concat (file-name-as-directory localname) "..")))) - (widen)) - (tramp-adb-sh-fix-ls-output) - (let ((result (tramp-do-parse-file-attributes-with-ls - v (or id-format 'integer)))) - (when full - (setq result - (mapcar - (lambda (x) - (cons (expand-file-name (car x) directory) (cdr x))) - result))) - (unless nosort - (setq result - (sort result (lambda (x y) (string< (car x) (car y)))))) - (delq nil - (mapcar (lambda (x) - (if (or (not match) (string-match match (car x))) - x)) - result)))))))) + (copy-tree + (with-tramp-file-property + v localname (format "directory-files-and-attributes-%s-%s-%s-%s" + full match id-format nosort) + (with-current-buffer (tramp-get-buffer v) + (when (tramp-adb-send-command-and-check + v (format "%s -a -l %s" + (tramp-adb-get-ls-command v) + (tramp-shell-quote-argument localname))) + ;; We insert also filename/. and filename/.., because "ls" doesn't. + (narrow-to-region (point) (point)) + (tramp-adb-send-command + v (format "%s -d -a -l %s %s" + (tramp-adb-get-ls-command v) + (tramp-shell-quote-argument + (concat (file-name-as-directory localname) ".")) + (tramp-shell-quote-argument + (concat (file-name-as-directory localname) "..")))) + (widen)) + (tramp-adb-sh-fix-ls-output) + (let ((result (tramp-do-parse-file-attributes-with-ls + v (or id-format 'integer)))) + (when full + (setq result + (mapcar + (lambda (x) + (cons (expand-file-name (car x) directory) (cdr x))) + result))) + (unless nosort + (setq result + (sort result (lambda (x y) (string< (car x) (car y)))))) + (delq nil + (mapcar (lambda (x) + (if (or (not match) (string-match match (car x))) + x)) + result))))))))) (defun tramp-adb-get-ls-command (vec) (with-tramp-connection-property vec "ls" commit 0382fd42c6979bbedc9230b789503258a5e963eb Author: Stephen Leake Date: Thu Aug 13 12:54:39 2015 -0500 xref-find-definitions: Exclude more generic function items. * lisp/emacs-lisp/cl-generic.el (cl--generic-search-method): Add doc string. (cl--generic-find-defgeneric-regexp): New. (find-function-regexp-alist): Add it. * lisp/emacs-lisp/find-func.el (find-feature-regexp): Move here from elisp-mode.el, change to search for ";;; Code:" (find-alias-regexp): Move here from elisp-mode.el, cleaned up. (find-function-regexp-alist): Add them. * lisp/progmodes/elisp-mode.el: (elisp--xref-format, elisp--xref-format-extra): Change back to defvar due to bug#21237. (elisp--xref-find-definitions): Exclude co-located default methods for generic functions. Also exclude implicitly declared defgeneric. (elisp--xref-find-definitions): Handle C source properly. Exclude minor mode variables defined by 'define-minor-mode'. * test/automated/elisp-mode-tests.el: Declare generic functions, add tests for them. (xref-elisp-test-run): Fix bug. (emacs-test-dir): Improve initial value. (find-defs-defun-defvar-el): Don't expect defvar. (find-defs-feature-el): Match change to find-feature-regexp. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 63cd910..a138697 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -791,6 +791,8 @@ Can only be used from within the lexical body of a primary or around method." ;;; Add support for describe-function (defun cl--generic-search-method (met-name) + "For `find-function-regexp-alist'. Searches for a cl-defmethod. +MET-NAME is a cons (SYMBOL . SPECIALIZERS)." (let ((base-re (concat "(\\(?:cl-\\)?defmethod[ \t]+" (regexp-quote (format "%s" (car met-name))) "\\_>"))) @@ -806,11 +808,15 @@ Can only be used from within the lexical body of a primary or around method." nil t) (re-search-forward base-re nil t)))) +;; WORKAROUND: This can't be a defconst due to bug#21237. +(defvar cl--generic-find-defgeneric-regexp "(\\(?:cl-\\)?defgeneric[ \t]+%s\\>") (with-eval-after-load 'find-func (defvar find-function-regexp-alist) (add-to-list 'find-function-regexp-alist - `(cl-defmethod . ,#'cl--generic-search-method))) + `(cl-defmethod . ,#'cl--generic-search-method)) + (add-to-list 'find-function-regexp-alist + `(cl-defgeneric . cl--generic-find-defgeneric-regexp))) (defun cl--generic-method-info (method) (let* ((specializers (cl--generic-method-specializers method)) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index cd23cd7..4dc0596 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -100,10 +100,34 @@ Please send improvements and fixes to the maintainer." :group 'find-function :version "22.1") +(defcustom find-feature-regexp + (concat ";;; Code:") + "The regexp used by `xref-find-definitions' when searching for a feature definition. +Note it must contain a `%s' at the place where `format' +should insert the feature name." + ;; We search for ";;; Code" rather than (feature '%s) because the + ;; former is near the start of the code, and the latter is very + ;; uninteresting. If the regexp is not found, just goes to + ;; (point-min), which is acceptable in this case. + :type 'regexp + :group 'xref + :version "25.0") + +(defcustom find-alias-regexp + "(defalias +'%s" + "The regexp used by `xref-find-definitions' to search for an alias definition. +Note it must contain a `%s' at the place where `format' +should insert the feature name." + :type 'regexp + :group 'xref + :version "25.0") + (defvar find-function-regexp-alist '((nil . find-function-regexp) (defvar . find-variable-regexp) - (defface . find-face-regexp)) + (defface . find-face-regexp) + (feature . find-feature-regexp) + (defalias . find-alias-regexp)) "Alist mapping definition types into regexp variables. Each regexp variable's value should actually be a format string to be used to substitute the desired symbol name into the regexp. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 7ac5a5c..8131457 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -604,40 +604,23 @@ It can be quoted, or be inside a quoted form." (`apropos (elisp--xref-find-apropos id)))) -(defconst elisp--xref-format +;; WORKAROUND: This is nominally a constant, but the text properities +;; are not preserved thru dump if use defconst. See bug#21237 +(defvar elisp--xref-format (let ((str "(%s %s)")) (put-text-property 1 3 'face 'font-lock-keyword-face str) (put-text-property 4 6 'face 'font-lock-function-name-face str) str)) -(defconst elisp--xref-format-extra +;; WORKAROUND: This is nominally a constant, but the text properities +;; are not preserved thru dump if use defconst. See bug#21237 +(defvar elisp--xref-format-extra (let ((str "(%s %s %s)")) (put-text-property 1 3 'face 'font-lock-keyword-face str) (put-text-property 4 6 'face 'font-lock-function-name-face str) str)) -(defcustom find-feature-regexp - (concat "(provide +'%s)") - "The regexp used by `xref-find-definitions' to search for a feature definition. -Note it must contain a `%s' at the place where `format' -should insert the feature name." - :type 'regexp - :group 'xref - :version "25.0") - -(defcustom find-alias-regexp - "(\\(defalias +'\\|def\\(const\\|face\\) +\\)%s" - "The regexp used by `xref-find-definitions' to search for an alias definition. -Note it must contain a `%s' at the place where `format' -should insert the feature name." - :type 'regexp - :group 'xref - :version "25.0") - -(with-eval-after-load 'find-func - (defvar find-function-regexp-alist) - (add-to-list 'find-function-regexp-alist (cons 'feature 'find-feature-regexp)) - (add-to-list 'find-function-regexp-alist (cons 'defalias 'find-alias-regexp))) +(defvar find-feature-regexp) (defun elisp--xref-make-xref (type symbol file &optional summary) "Return an xref for TYPE SYMBOL in FILE. @@ -683,9 +666,10 @@ otherwise build the summary from TYPE and SYMBOL." (when file (cond ((eq file 'C-source) - ;; First call to find-lisp-object-file-name (for this - ;; symbol?); C-source has not been cached yet. - ;; Second call will return "src/*.c" in file; handled by 't' case below. + ;; First call to find-lisp-object-file-name for an object + ;; defined in C; the doc strings from the C source have + ;; not been loaded yet. Second call will return "src/*.c" + ;; in file; handled by 't' case below. (push (elisp--xref-make-xref nil symbol (help-C-file-name (symbol-function symbol) 'subr)) xrefs)) ((and (setq doc (documentation symbol t)) @@ -704,17 +688,42 @@ otherwise build the summary from TYPE and SYMBOL." )) ((setq generic (cl--generic symbol)) + ;; A generic function. If there is a default method, it + ;; will appear in the method table, with no + ;; specializers. + ;; + ;; If the default method is declared by the cl-defgeneric + ;; declaration, it will have the same location as teh + ;; cl-defgeneric, so we want to exclude it from the + ;; result. In this case, it will have a null doc + ;; string. User declarations of default methods may also + ;; have null doc strings, but we hope that is + ;; rare. Perhaps this hueristic will discourage that. (dolist (method (cl--generic-method-table generic)) - (let* ((info (cl--generic-method-info method)) - (met-name (cons symbol (cl--generic-method-specializers method))) - (descr (format elisp--xref-format-extra 'cl-defmethod symbol (nth 1 info))) + (let* ((info (cl--generic-method-info method));; qual-string combined-args doconly + (specializers (cl--generic-method-specializers method)) + (met-name (cons symbol specializers)) (file (find-lisp-object-file-name met-name 'cl-defmethod))) - (when file - (push (elisp--xref-make-xref 'cl-defmethod met-name file descr) xrefs)) + (when (and file + (or specializers ;; default method has null specializers + (nth 2 info))) ;; assuming only co-located default has null doc string + (if specializers + (let ((summary (format elisp--xref-format-extra 'cl-defmethod symbol (nth 1 info)))) + (push (elisp--xref-make-xref 'cl-defmethod met-name file summary) xrefs)) + + (let ((summary (format elisp--xref-format-extra 'cl-defmethod symbol "()"))) + (push (elisp--xref-make-xref 'cl-defmethod met-name file summary) xrefs)))) )) - (let ((descr (format elisp--xref-format 'cl-defgeneric symbol))) - (push (elisp--xref-make-xref nil symbol file descr) xrefs)) + (if (and (setq doc (documentation symbol t)) + ;; This doc string is created somewhere in + ;; cl--generic-make-function for an implicit + ;; defgeneric. + (string-match "\n\n(fn ARG &rest ARGS)" doc)) + ;; This symbol is an implicitly defined defgeneric, so + ;; don't return it. + nil + (push (elisp--xref-make-xref 'cl-defgeneric symbol file) xrefs)) ) (t @@ -722,11 +731,43 @@ otherwise build the summary from TYPE and SYMBOL." )))) (when (boundp symbol) + ;; A variable (let ((file (find-lisp-object-file-name symbol 'defvar))) (when file - (when (eq file 'C-source) - (setq file (help-C-file-name symbol 'var))) - (push (elisp--xref-make-xref 'defvar symbol file) xrefs)))) + (cond + ((eq file 'C-source) + ;; The doc strings from the C source have not been loaded + ;; yet; help-C-file-name does that. Second call will + ;; return "src/*.c" in file; handled below. + (push (elisp--xref-make-xref 'defvar symbol (help-C-file-name symbol 'var)) xrefs)) + + ((string= "src/" (substring file 0 4)) + ;; The variable is defined in a C source file; don't check + ;; for define-minor-mode. + (push (elisp--xref-make-xref 'defvar symbol file) xrefs)) + + ((memq symbol minor-mode-list) + ;; The symbol is a minor mode. These should be defined by + ;; "define-minor-mode", which means the variable and the + ;; function are declared in the same place. So we return only + ;; the function, arbitrarily. + ;; + ;; There is an exception, when the variable is defined in C + ;; code, as for abbrev-mode. + ;; + ;; IMPROVEME: If the user is searching for the identifier at + ;; point, we can determine whether it is a variable or + ;; function by looking at the source code near point. + ;; + ;; IMPROVEME: The user may actually be asking "do any + ;; variables by this name exist"; we need a way to specify + ;; that. + nil) + + (t + (push (elisp--xref-make-xref 'defvar symbol file) xrefs)) + + )))) (when (featurep symbol) (let ((file (ignore-errors diff --git a/test/automated/elisp-mode-tests.el b/test/automated/elisp-mode-tests.el index 9b4014a..47212e9 100644 --- a/test/automated/elisp-mode-tests.el +++ b/test/automated/elisp-mode-tests.el @@ -177,8 +177,8 @@ (defun xref-elisp-test-run (xrefs expecteds) + (should (= (length xrefs) (length expecteds))) (while xrefs - (should (= (length xrefs) (length expecteds))) (let ((xref (pop xrefs)) (expected (pop expecteds))) @@ -204,8 +204,9 @@ to (xref-elisp-test-descr-to-target xref)." ;; When tests are run from the Makefile, 'default-directory' is $HOME, ;; so we must provide this dir to expand-file-name in the expected -;; results. The Makefile sets EMACS_TEST_DIRECTORY. -(defconst emacs-test-dir (getenv "EMACS_TEST_DIRECTORY")) +;; results. This also allows running these tests from other +;; directories. +(defconst emacs-test-dir (file-name-directory (or load-file-name (buffer-file-name)))) ;; alphabetical by test name @@ -244,12 +245,144 @@ to (xref-elisp-test-descr-to-target xref)." ;; FIXME: defconst +;; FIXME: eieio defclass + +;; Possible ways of defining the default method implementation for a +;; generic function. We declare these here, so we know we cover all +;; cases, and we don't rely on other code not changing. +;; +;; When the generic and default method are declared in the same place, +;; elisp--xref-find-definitions only returns one. + +(cl-defstruct (xref-elisp-root-type) + slot-1) + +(cl-defgeneric xref-elisp-generic-no-methods () + "doc string no-methods" + ;; No default implementation, no methods, but fboundp is true for + ;; this symbol; it calls cl-no-applicable-method + ) + +(cl-defmethod xref-elisp-generic-no-default ((this xref-elisp-root-type)) + "doc string no-default xref-elisp-root-type" + "non-default for no-default") + +;; defgeneric after defmethod in file to ensure the fallback search +;; method of just looking for the function name will fail. +(cl-defgeneric xref-elisp-generic-no-default () + "doc string no-default generic" + ;; No default implementation; this function calls the cl-generic + ;; dispatching code. + ) + +(cl-defgeneric xref-elisp-generic-co-located-default () + "doc string co-located-default generic" + "co-located default") + +(cl-defmethod xref-elisp-generic-co-located-default ((this xref-elisp-root-type)) + "doc string co-located-default xref-elisp-root-type" + "non-default for co-located-default") + +(cl-defgeneric xref-elisp-generic-separate-default () + "doc string separate-default generic" + ;; default implementation provided separately + ) + +(cl-defmethod xref-elisp-generic-separate-default () + "doc string separate-default default" + "separate default") + +(cl-defmethod xref-elisp-generic-separate-default ((this xref-elisp-root-type)) + "doc string separate-default xref-elisp-root-type" + "non-default for separate-default") + +(cl-defmethod xref-elisp-generic-implicit-generic () + "doc string implict-generic default" + "default for implicit generic") + +(cl-defmethod xref-elisp-generic-implicit-generic ((this xref-elisp-root-type)) + "doc string implict-generic xref-elisp-root-type" + "non-default for implicit generic") + + +(xref-elisp-deftest find-defs-defgeneric-no-methods + (elisp--xref-find-definitions 'xref-elisp-generic-no-methods) + (list + (xref-make "(cl-defgeneric xref-elisp-generic-no-methods)" + (xref-make-elisp-location + 'xref-elisp-generic-no-methods 'cl-defgeneric + (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) + )) + +(xref-elisp-deftest find-defs-defgeneric-no-default + (elisp--xref-find-definitions 'xref-elisp-generic-no-default) + (list + (xref-make "(cl-defgeneric xref-elisp-generic-no-default)" + (xref-make-elisp-location + 'xref-elisp-generic-no-default 'cl-defgeneric + (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) + (xref-make "(cl-defmethod xref-elisp-generic-no-default ((this xref-elisp-root-type)))" + (xref-make-elisp-location + '(xref-elisp-generic-no-default xref-elisp-root-type) 'cl-defmethod + (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) + )) + +(xref-elisp-deftest find-defs-defgeneric-co-located-default + (elisp--xref-find-definitions 'xref-elisp-generic-co-located-default) + (list + (xref-make "(cl-defgeneric xref-elisp-generic-co-located-default)" + (xref-make-elisp-location + 'xref-elisp-generic-co-located-default 'cl-defgeneric + (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) + (xref-make "(cl-defmethod xref-elisp-generic-co-located-default ((this xref-elisp-root-type)))" + (xref-make-elisp-location + '(xref-elisp-generic-co-located-default xref-elisp-root-type) 'cl-defmethod + (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) + )) + +(xref-elisp-deftest find-defs-defgeneric-separate-default + (elisp--xref-find-definitions 'xref-elisp-generic-separate-default) + (list + (xref-make "(cl-defgeneric xref-elisp-generic-separate-default)" + (xref-make-elisp-location + 'xref-elisp-generic-separate-default 'cl-defgeneric + (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) + (xref-make "(cl-defmethod xref-elisp-generic-separate-default ())" + (xref-make-elisp-location + '(xref-elisp-generic-separate-default) 'cl-defmethod + (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) + + (xref-make "(cl-defmethod xref-elisp-generic-separate-default ((this xref-elisp-root-type)))" + (xref-make-elisp-location + '(xref-elisp-generic-separate-default xref-elisp-root-type) 'cl-defmethod + (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) + )) + +(xref-elisp-deftest find-defs-defgeneric-implicit-generic + (elisp--xref-find-definitions 'xref-elisp-generic-implicit-generic) + (list + (xref-make "(cl-defmethod xref-elisp-generic-implicit-generic ())" + (xref-make-elisp-location + '(xref-elisp-generic-implicit-generic) 'cl-defmethod + (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) + (xref-make "(cl-defmethod xref-elisp-generic-implicit-generic ((this xref-elisp-root-type)))" + (xref-make-elisp-location + '(xref-elisp-generic-implicit-generic xref-elisp-root-type) 'cl-defmethod + (expand-file-name "elisp-mode-tests.el" emacs-test-dir))) + )) + +;; Test that we handle more than one method + +;; When run from the Makefile, etags is not loaded at compile time, +;; but it is by the time this test is run. interactively; don't fail +;; for that. +(require 'etags) (xref-elisp-deftest find-defs-defgeneric-el (elisp--xref-find-definitions 'xref-location-marker) (list (xref-make "(cl-defgeneric xref-location-marker)" (xref-make-elisp-location - 'xref-location-marker nil + 'xref-location-marker 'cl-defgeneric (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir))) (xref-make "(cl-defmethod xref-location-marker ((l xref-elisp-location)))" (xref-make-elisp-location @@ -267,7 +400,10 @@ to (xref-elisp-test-descr-to-target xref)." (xref-make-elisp-location '(xref-location-marker xref-bogus-location) 'cl-defmethod (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir))) - ;; etags is not loaded at test time + (xref-make "(cl-defmethod xref-location-marker ((l xref-etags-location)))" + (xref-make-elisp-location + '(xref-location-marker xref-etags-location) 'cl-defmethod + (expand-file-name "../../lisp/progmodes/etags.el" emacs-test-dir))) )) (xref-elisp-deftest find-defs-defgeneric-eval @@ -318,20 +454,19 @@ to (xref-elisp-test-descr-to-target xref)." ) ;; Source for both variable and defun is "(define-minor-mode -;; compilation-minor-mode". There is no way to tell that from the -;; symbol. find-function-regexp-alist uses find-function-regexp for -;; this, but that matches too many things for use in this test. +;; compilation-minor-mode". There is no way to tell that directly from +;; the symbol, but we can use (memq sym minor-mode-list) to detect +;; that the symbol is a minor mode. See `elisp--xref-find-definitions' +;; for more comments. +;; +;; IMPROVEME: return defvar instead of defun if source near starting +;; point indicates the user is searching for a varible, not a +;; function. (require 'compile) ;; not loaded by default at test time (xref-elisp-deftest find-defs-defun-defvar-el (elisp--xref-find-definitions 'compilation-minor-mode) (list (cons - (xref-make "(defvar compilation-minor-mode)" - (xref-make-elisp-location - 'compilation-minor-mode 'defvar - (expand-file-name "../../lisp/progmodes/compile.el" emacs-test-dir))) - "(define-minor-mode compilation-minor-mode") - (cons (xref-make "(defun compilation-minor-mode)" (xref-make-elisp-location 'compilation-minor-mode nil @@ -382,10 +517,13 @@ to (xref-elisp-test-descr-to-target xref)." (xref-elisp-deftest find-defs-feature-el (elisp--xref-find-definitions 'xref) (list - (xref-make "(feature xref)" + (cons + (xref-make "(feature xref)" (xref-make-elisp-location 'xref 'feature - (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir))))) + (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir))) + ";;; Code:") + )) (xref-elisp-deftest find-defs-feature-eval (elisp--xref-find-definitions (eval '(provide 'stephe-leake-feature))) commit 9c13a81a9e1aa74901cd958d7adb3ca71966dbef Author: Eli Zaretskii Date: Thu Aug 13 17:36:38 2015 +0300 Improve warning about purecopy of strings with properties * src/alloc.c (purecopy): Show the offending string with the warning about removing its text properties. diff --git a/src/alloc.c b/src/alloc.c index 9ac3ad8..050097c 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5353,7 +5353,8 @@ purecopy (Lisp_Object obj) else if (STRINGP (obj)) { if (XSTRING (obj)->intervals) - message ("Dropping text-properties when making string pure"); + message_with_string ("Dropping text-properties while making string `%s' pure", + obj, true); obj = make_pure_string (SSDATA (obj), SCHARS (obj), SBYTES (obj), STRING_MULTIBYTE (obj));