diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/data.c | 17 | ||||
| -rw-r--r-- | src/editfns.c | 6 | ||||
| -rw-r--r-- | src/eval.c | 19 | ||||
| -rw-r--r-- | src/fileio.c | 52 | ||||
| -rw-r--r-- | src/gtkutil.c | 25 | ||||
| -rw-r--r-- | src/lastfile.c | 3 | ||||
| -rw-r--r-- | src/lisp.h | 16 | ||||
| -rw-r--r-- | src/msdos.c | 2 | ||||
| -rw-r--r-- | src/regex.c | 32 | ||||
| -rw-r--r-- | src/w32fns.c | 11 |
10 files changed, 128 insertions, 55 deletions
diff --git a/src/data.c b/src/data.c index ef7210fbfa0..00d1eb43033 100644 --- a/src/data.c +++ b/src/data.c @@ -3069,6 +3069,22 @@ usage: (logxor &rest INTS-OR-MARKERS) */) return arith_driver (Alogxor, nargs, args); } +DEFUN ("logcount", Flogcount, Slogcount, 1, 1, 0, + doc: /* Return population count of VALUE. +This is the number of one bits in the two's complement representation +of VALUE. If VALUE is negative, return the number of zero bits in the +representation. */) + (Lisp_Object value) +{ + CHECK_NUMBER (value); + EMACS_INT v = XINT (value) < 0 ? -1 - XINT (value) : XINT (value); + return make_number (EMACS_UINT_WIDTH <= UINT_WIDTH + ? count_one_bits (v) + : EMACS_UINT_WIDTH <= ULONG_WIDTH + ? count_one_bits_l (v) + : count_one_bits_ll (v)); +} + static Lisp_Object ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh) { @@ -3856,6 +3872,7 @@ syms_of_data (void) defsubr (&Slogand); defsubr (&Slogior); defsubr (&Slogxor); + defsubr (&Slogcount); defsubr (&Slsh); defsubr (&Sash); defsubr (&Sadd1); diff --git a/src/editfns.c b/src/editfns.c index 81cda4af062..e250c91ecbc 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1257,10 +1257,10 @@ If POS is out of range, the value is nil. */) if (NILP (pos)) { pos_byte = PT_BYTE; - XSETFASTINT (pos, PT); + if (pos_byte < BEGV_BYTE || pos_byte >= ZV_BYTE) + return Qnil; } - - if (MARKERP (pos)) + else if (MARKERP (pos)) { pos_byte = marker_byte_position (pos); if (pos_byte < BEGV_BYTE || pos_byte >= ZV_BYTE) diff --git a/src/eval.c b/src/eval.c index 52e4c96d4b2..063deb4ba03 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1986,12 +1986,10 @@ it defines a macro. */) if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef))) return fundef; - if (EQ (macro_only, Qmacro)) - { - Lisp_Object kind = Fnth (make_number (4), fundef); - if (! (EQ (kind, Qt) || EQ (kind, Qmacro))) - return fundef; - } + Lisp_Object kind = Fnth (make_number (4), fundef); + if (EQ (macro_only, Qmacro) + && !(EQ (kind, Qt) || EQ (kind, Qmacro))) + return fundef; /* This is to make sure that loadup.el gives a clear picture of what files are preloaded and when. */ @@ -2014,15 +2012,18 @@ it defines a macro. */) The value saved here is to be restored into Vautoload_queue. */ record_unwind_protect (un_autoload, Vautoload_queue); Vautoload_queue = Qt; - /* If `macro_only', assume this autoload to be a "best-effort", + /* If `macro_only' is set and fundef isn't a macro, assume this autoload to + be a "best-effort" (e.g. to try and find a compiler macro), so don't signal an error if autoloading fails. */ - Fload (Fcar (Fcdr (fundef)), macro_only, Qt, Qnil, Qt); + Lisp_Object ignore_errors + = (EQ (kind, Qt) || EQ (kind, Qmacro)) ? Qnil : macro_only; + Fload (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt); /* Once loading finishes, don't undo it. */ Vautoload_queue = Qt; unbind_to (count, Qnil); - if (NILP (funname)) + if (NILP (funname) || !NILP (ignore_errors)) return Qnil; else { diff --git a/src/fileio.c b/src/fileio.c index cc1399e1bda..fb66118905f 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -96,6 +96,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <acl.h> #include <allocator.h> #include <careadlinkat.h> +#include <fsusage.h> #include <stat-time.h> #include <tempname.h> @@ -5783,6 +5784,52 @@ effect except for flushing STREAM's data. */) return (set_binary_mode (fileno (fp), binmode) == O_BINARY) ? Qt : Qnil; } +#ifndef DOS_NT + +/* Yield a Lisp float as close as possible to BLOCKSIZE * BLOCKS, with + the result negated if NEGATE. */ +static Lisp_Object +blocks_to_bytes (uintmax_t blocksize, uintmax_t blocks, bool negate) +{ + /* On typical platforms the following code is accurate to 53 bits, + which is close enough. BLOCKSIZE is invariably a power of 2, so + converting it to double does not lose information. */ + double bs = blocksize; + return make_float (negate ? -bs * -blocks : bs * blocks); +} + +DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0, + doc: /* Return storage information about the file system FILENAME is on. +Value is a list of numbers (TOTAL FREE AVAIL), where TOTAL is the total +storage of the file system, FREE is the free storage, and AVAIL is the +storage available to a non-superuser. All 3 numbers are in bytes. +If the underlying system call fails, value is nil. */) + (Lisp_Object filename) +{ + Lisp_Object encoded = ENCODE_FILE (Fexpand_file_name (filename, Qnil)); + + /* If the file name has special constructs in it, + call the corresponding file handler. */ + Lisp_Object handler = Ffind_file_name_handler (encoded, Qfile_system_info); + if (!NILP (handler)) + { + Lisp_Object result = call2 (handler, Qfile_system_info, encoded); + if (CONSP (result) || NILP (result)) + return result; + error ("Invalid handler in `file-name-handler-alist'"); + } + + struct fs_usage u; + if (get_fs_usage (SSDATA (encoded), NULL, &u) != 0) + return Qnil; + return list3 (blocks_to_bytes (u.fsu_blocksize, u.fsu_blocks, false), + blocks_to_bytes (u.fsu_blocksize, u.fsu_bfree, false), + blocks_to_bytes (u.fsu_blocksize, u.fsu_bavail, + u.fsu_bavail_top_bit_set)); +} + +#endif /* !DOS_NT */ + void init_fileio (void) { @@ -5853,6 +5900,7 @@ syms_of_fileio (void) DEFSYM (Qwrite_region, "write-region"); DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime"); DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime"); + DEFSYM (Qfile_system_info, "file-system-info"); /* The symbol bound to coding-system-for-read when insert-file-contents is called for recovering a file. This is not @@ -6133,6 +6181,10 @@ This includes interactive calls to `delete-file' and defsubr (&Sset_binary_mode); +#ifndef DOS_NT + defsubr (&Sfile_system_info); +#endif + #ifdef HAVE_SYNC defsubr (&Sunix_sync); #endif diff --git a/src/gtkutil.c b/src/gtkutil.c index c7d8f92829a..4aa2c9bb5e0 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1061,16 +1061,23 @@ static void xg_set_widget_bg (struct frame *f, GtkWidget *w, unsigned long pixel) { #ifdef HAVE_GTK3 - GdkRGBA bg; XColor xbg; xbg.pixel = pixel; if (XQueryColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), &xbg)) { - bg.red = (double)xbg.red/65535.0; - bg.green = (double)xbg.green/65535.0; - bg.blue = (double)xbg.blue/65535.0; - bg.alpha = 1.0; - gtk_widget_override_background_color (w, GTK_STATE_FLAG_NORMAL, &bg); + const char format[] = "* { background-color: #%02x%02x%02x; }"; + /* The format is always longer than the resulting string. */ + char buffer[sizeof format]; + int n = snprintf(buffer, sizeof buffer, format, + xbg.red >> 8, xbg.green >> 8, xbg.blue >> 8); + eassert (n > 0); + eassert (n < sizeof buffer); + GtkCssProvider *provider = gtk_css_provider_new (); + gtk_css_provider_load_from_data (provider, buffer, -1, NULL); + gtk_style_context_add_provider (gtk_widget_get_style_context(w), + GTK_STYLE_PROVIDER (provider), + GTK_STYLE_PROVIDER_PRIORITY_APPLICATION); + g_clear_object (&provider); } #else GdkColor bg; @@ -1234,9 +1241,11 @@ xg_create_frame_widgets (struct frame *f) X and GTK+ drawing to a pure GTK+ build. */ gtk_widget_set_double_buffered (wfixed, FALSE); +#if ! GTK_CHECK_VERSION (3, 22, 0) gtk_window_set_wmclass (GTK_WINDOW (wtop), SSDATA (Vx_resource_name), SSDATA (Vx_resource_class)); +#endif /* Add callback to do nothing on WM_DELETE_WINDOW. The default in GTK is to destroy the widget. We want Emacs to do that instead. */ @@ -4099,8 +4108,10 @@ xg_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, if (int_gtk_range_get_value (GTK_RANGE (wscroll)) != value) gtk_range_set_value (GTK_RANGE (wscroll), (gdouble)value); +#if ! GTK_CHECK_VERSION (3, 18, 0) else if (changed) gtk_adjustment_changed (adj); +#endif xg_ignore_gtk_scrollbar = 0; @@ -4137,7 +4148,9 @@ xg_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, gtk_adjustment_configure (adj, (gdouble) value, (gdouble) lower, (gdouble) upper, (gdouble) step_increment, (gdouble) page_increment, (gdouble) pagesize); +#if ! GTK_CHECK_VERSION (3, 18, 0) gtk_adjustment_changed (adj); +#endif unblock_input (); } } diff --git a/src/lastfile.c b/src/lastfile.c index 2901f148e17..13022792f25 100644 --- a/src/lastfile.c +++ b/src/lastfile.c @@ -49,9 +49,6 @@ char my_edata[] = "End of Emacs initialized data"; isn't always a separate section in NT executables). */ char my_endbss[1]; -/* The Alpha MSVC linker globally segregates all static and public bss - data, so we must take both into account to determine the true extent - of the bss area used by Emacs. */ static char _my_endbss[1]; char * my_endbss_static = _my_endbss; diff --git a/src/lisp.h b/src/lisp.h index 4dd472053bf..78843483edc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -424,9 +424,8 @@ error !; #define case_Lisp_Int case Lisp_Int0: case Lisp_Int1 /* Idea stolen from GDB. Pedantic GCC complains about enum bitfields, - MSVC doesn't support them, and xlc and Oracle Studio c99 complain - vociferously about them. */ -#if (defined __STRICT_ANSI__ || defined _MSC_VER || defined __IBMC__ \ + and xlc and Oracle Studio c99 complain vociferously about them. */ +#if (defined __STRICT_ANSI__ || defined __IBMC__ \ || (defined __SUNPRO_C && __STDC__)) #define ENUM_BF(TYPE) unsigned int #else @@ -2941,23 +2940,12 @@ CHECK_NUMBER_CDR (Lisp_Object x) /* This version of DEFUN declares a function prototype with the right arguments, so we can catch errors with maxargs at compile-time. */ -#ifdef _MSC_VER -#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ - Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ - static struct Lisp_Subr GCALIGNED sname = \ - { { (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) \ - | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)) }, \ - { (Lisp_Object (__cdecl *)(void))fnname }, \ - minargs, maxargs, lname, intspec, 0}; \ - Lisp_Object fnname -#else /* not _MSC_VER */ #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ static struct Lisp_Subr GCALIGNED sname = \ { { PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ { .a ## maxargs = fnname }, \ minargs, maxargs, lname, intspec, 0}; \ Lisp_Object fnname -#endif /* defsubr (Sname); is how we define the symbol for function `name' at start-up time. */ diff --git a/src/msdos.c b/src/msdos.c index 43730ebedc3..f7c99f63fff 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -1791,7 +1791,7 @@ internal_terminal_init (void) } Vinitial_window_system = Qpc; - Vwindow_system_version = make_number (26); /* RE Emacs version */ + Vwindow_system_version = make_number (27); /* RE Emacs version */ tty->terminal->type = output_msdos_raw; /* If Emacs was dumped on DOS/V machine, forget the stale VRAM diff --git a/src/regex.c b/src/regex.c index 330f2f78a84..d3d910daaa3 100644 --- a/src/regex.c +++ b/src/regex.c @@ -519,13 +519,7 @@ ptrdiff_t emacs_re_safe_alloca = MAX_ALLOCA; #endif /* Type of source-pattern and string chars. */ -#ifdef _MSC_VER -typedef unsigned char re_char; -typedef const re_char const_re_char; -#else typedef const unsigned char re_char; -typedef re_char const_re_char; -#endif typedef char boolean; @@ -2403,7 +2397,7 @@ do { \ } while (0) static reg_errcode_t -regex_compile (const_re_char *pattern, size_t size, +regex_compile (re_char *pattern, size_t size, #ifdef emacs # define syntax RE_SYNTAX_EMACS bool posix_backtracking, @@ -3728,7 +3722,7 @@ insert_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2, unsigned cha least one character before the ^. */ static boolean -at_begline_loc_p (const_re_char *pattern, const_re_char *p, reg_syntax_t syntax) +at_begline_loc_p (re_char *pattern, re_char *p, reg_syntax_t syntax) { re_char *prev = p - 2; boolean odd_backslashes; @@ -3769,7 +3763,7 @@ at_begline_loc_p (const_re_char *pattern, const_re_char *p, reg_syntax_t syntax) at least one character after the $, i.e., `P < PEND'. */ static boolean -at_endline_loc_p (const_re_char *p, const_re_char *pend, reg_syntax_t syntax) +at_endline_loc_p (re_char *p, re_char *pend, reg_syntax_t syntax) { re_char *next = p; boolean next_backslash = *next == '\\'; @@ -3813,7 +3807,7 @@ group_in_compile_stack (compile_stack_type compile_stack, regnum_t regnum) Return -1 if fastmap was not updated accurately. */ static int -analyze_first (const_re_char *p, const_re_char *pend, char *fastmap, +analyze_first (re_char *p, re_char *pend, char *fastmap, const int multibyte) { int j, k; @@ -4555,7 +4549,7 @@ static int bcmp_translate (re_char *s1, re_char *s2, /* If the operation is a match against one or more chars, return a pointer to the next operation, else return NULL. */ static re_char * -skip_one_char (const_re_char *p) +skip_one_char (re_char *p) { switch (*p++) { @@ -4597,7 +4591,7 @@ skip_one_char (const_re_char *p) /* Jump over non-matching operations. */ static re_char * -skip_noops (const_re_char *p, const_re_char *pend) +skip_noops (re_char *p, re_char *pend) { int mcnt; while (p < pend) @@ -4628,7 +4622,7 @@ skip_noops (const_re_char *p, const_re_char *pend) character (i.e. without any translations). UNIBYTE denotes whether c is unibyte or multibyte character. */ static bool -execute_charset (const_re_char **pp, unsigned c, unsigned corig, bool unibyte) +execute_charset (re_char **pp, unsigned c, unsigned corig, bool unibyte) { re_char *p = *pp, *rtp = NULL; bool not = (re_opcode_t) *p == charset_not; @@ -4692,8 +4686,8 @@ execute_charset (const_re_char **pp, unsigned c, unsigned corig, bool unibyte) /* Non-zero if "p1 matches something" implies "p2 fails". */ static int -mutually_exclusive_p (struct re_pattern_buffer *bufp, const_re_char *p1, - const_re_char *p2) +mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1, + re_char *p2) { re_opcode_t op2; const boolean multibyte = RE_MULTIBYTE_P (bufp); @@ -4931,8 +4925,8 @@ WEAK_ALIAS (__re_match_2, re_match_2) /* This is a separate function so that we can force an alloca cleanup afterwards. */ static regoff_t -re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1, - size_t size1, const_re_char *string2, size_t size2, +re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, + size_t size1, re_char *string2, size_t size2, ssize_t pos, struct re_registers *regs, ssize_t stop) { /* General temporaries. */ @@ -6222,10 +6216,10 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1, bytes; nonzero otherwise. */ static int -bcmp_translate (const_re_char *s1, const_re_char *s2, register ssize_t len, +bcmp_translate (re_char *s1, re_char *s2, ssize_t len, RE_TRANSLATE_TYPE translate, const int target_multibyte) { - register re_char *p1 = s1, *p2 = s2; + re_char *p1 = s1, *p2 = s2; re_char *p1_end = s1 + len; re_char *p2_end = s2 + len; diff --git a/src/w32fns.c b/src/w32fns.c index 43af1122fad..d2d4b2c7355 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -9337,6 +9337,17 @@ If the underlying system call fails, value is nil. */) filename = Fexpand_file_name (filename, Qnil); encoded = ENCODE_FILE (filename); + /* If the file name has special constructs in it, + call the corresponding file handler. */ + Lisp_Object handler = Ffind_file_name_handler (encoded, Qfile_system_info); + if (!NILP (handler)) + { + value = call2 (handler, Qfile_system_info, encoded); + if (CONSP (value) || NILP (value)) + return value; + error ("Invalid handler in `file-name-handler-alist'"); + } + value = Qnil; /* Determining the required information on Windows turns out, sadly, |