From 58cc0a010b7e16dfcf03d7e858ea27eba5dece65 Mon Sep 17 00:00:00 2001 From: Dmitry Antipov Date: Thu, 10 Jan 2013 14:30:16 +0400 Subject: [PATCH] Omit buffer_slot_type_mismatch and use generic predicates to enforce the type of per-buffer values where appropriate. * src/lisp.h (struct Lisp_Buffer_Objfwd): Rename slottype member to predicate, which is how it's really used now. Adjust comment. * src/buffer.h (buffer_slot_type_mismatch): Remove prototype. * src/buffer.c (buffer_slot_type_mismatch): Remove. (DEFVAR_PER_BUFFER, defvar_per_buffer): Rename type argument to predicate. Adjust comment. (syms_of_buffer): Use Qsymbolp for major-mode. Use Qintegerp for fill-column, left-margin, tab-width, buffer-saved-size, left-margin-width, right-margin-width, left-fringe-width, right-fringe-width, scroll-bar-width and buffer-display-count. Use Qstringp for default-directory, buffer-file-name, buffer-file-truename and buffer-auto-save-file-name. Use Qfloatp for scroll-up-aggressively and scroll-down-aggressively. Use Qnumberp for line-spacing. * src/data.c (store_symval_forwarding): Adjust to call the predicate. * lisp/cus-start.el (toplevel): Only allow float values for scroll-up-aggressively and scroll-down-aggressively. Allow any number for line-spacing. --- lisp/ChangeLog | 6 ++++ lisp/cus-start.el | 6 ++-- src/ChangeLog | 20 +++++++++++ src/buffer.c | 86 ++++++++++++++++++----------------------------- src/buffer.h | 1 - src/data.c | 10 +++--- src/lisp.h | 3 +- 7 files changed, 67 insertions(+), 65 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8611edd3bf..19968c46aa 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2013-01-10 Dmitry Antipov + + * cus-start.el (toplevel): Only allow float values for + scroll-up-aggressively and scroll-down-aggressively. + Allow any number for line-spacing. + 2013-01-10 Stefan Monnier * doc-view.el (doc-view-pdfdraw-program): Allow "pdfdraw" name. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 9d2c275098..b954ed60ba 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -115,12 +115,12 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (const :tag "On the right" (down . right)))) (other :tag "On left, no arrows" t))) (scroll-up-aggressively windows - (choice (const :tag "off" nil) number) + (choice (const :tag "off" nil) float) "21.1") (scroll-down-aggressively windows - (choice (const :tag "off" nil) number) + (choice (const :tag "off" nil) float) "21.1") - (line-spacing display (choice (const :tag "none" nil) integer) + (line-spacing display (choice (const :tag "none" nil) number) "22.1") (cursor-in-non-selected-windows cursor boolean nil diff --git a/src/ChangeLog b/src/ChangeLog index 6ce141331e..55a233adcd 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,23 @@ +2013-01-10 Dmitry Antipov + + Omit buffer_slot_type_mismatch and use generic predicates to enforce + the type of per-buffer values where appropriate. + * lisp.h (struct Lisp_Buffer_Objfwd): Rename slottype member to + predicate, which is how it's really used now. Adjust comment. + * buffer.h (buffer_slot_type_mismatch): Remove prototype. + * buffer.c (buffer_slot_type_mismatch): Remove. + (DEFVAR_PER_BUFFER, defvar_per_buffer): Rename type argument to + predicate. Adjust comment. + (syms_of_buffer): Use Qsymbolp for major-mode. Use Qintegerp for + fill-column, left-margin, tab-width, buffer-saved-size, + left-margin-width, right-margin-width, left-fringe-width, + right-fringe-width, scroll-bar-width and buffer-display-count. + Use Qstringp for default-directory, buffer-file-name, + buffer-file-truename and buffer-auto-save-file-name. Use Qfloatp for + scroll-up-aggressively and scroll-down-aggressively. Use Qnumberp for + line-spacing. + * data.c (store_symval_forwarding): Adjust to call the predicate. + 2013-01-09 Juanma Barranquero * w32.c (get_name_and_id, acl_set_file): diff --git a/src/buffer.c b/src/buffer.c index 51c4d9c71d..218ae1a7d1 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -4576,27 +4576,7 @@ evaporate_overlays (ptrdiff_t pos) for (; CONSP (hit_list); hit_list = XCDR (hit_list)) Fdelete_overlay (XCAR (hit_list)); } - -/* Somebody has tried to store a value with an unacceptable type - in the slot with offset OFFSET. */ -void -buffer_slot_type_mismatch (Lisp_Object newval, int type) -{ - Lisp_Object predicate; - - switch (type) - { - case_Lisp_Int: predicate = Qintegerp; break; - case Lisp_String: predicate = Qstringp; break; - case Lisp_Symbol: predicate = Qsymbolp; break; - default: emacs_abort (); - } - - wrong_type_argument (predicate, newval); -} - - /*********************************************************************** Allocation with mmap ***********************************************************************/ @@ -5370,25 +5350,23 @@ init_buffer (void) free (pwd); } -/* Similar to defvar_lisp but define a variable whose value is the Lisp - Object stored in the current buffer. address is the address of the slot - in the buffer that is current now. */ - -/* TYPE is nil for a general Lisp variable. - An integer specifies a type; then only Lisp values - with that type code are allowed (except that nil is allowed too). - LNAME is the Lisp-level variable name. - VNAME is the name of the buffer slot. - DOC is a dummy where you write the doc string as a comment. */ -#define DEFVAR_PER_BUFFER(lname, vname, type, doc) \ - do { \ - static struct Lisp_Buffer_Objfwd bo_fwd; \ - defvar_per_buffer (&bo_fwd, lname, vname, type); \ +/* Similar to defvar_lisp but define a variable whose value is the + Lisp_Object stored in the current buffer. LNAME is the Lisp-level + variable name. VNAME is the name of the buffer slot. PREDICATE + is nil for a general Lisp variable. If PREDICATE is non-nil, then + only Lisp values that satisfies the PREDICATE are allowed (except + that nil is allowed too). DOC is a dummy where you write the doc + string as a comment. */ + +#define DEFVAR_PER_BUFFER(lname, vname, predicate, doc) \ + do { \ + static struct Lisp_Buffer_Objfwd bo_fwd; \ + defvar_per_buffer (&bo_fwd, lname, vname, predicate); \ } while (0) static void defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring, - Lisp_Object *address, Lisp_Object type) + Lisp_Object *address, Lisp_Object predicate) { struct Lisp_Symbol *sym; int offset; @@ -5398,7 +5376,7 @@ defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring, bo_fwd->type = Lisp_Fwd_Buffer_Obj; bo_fwd->offset = offset; - bo_fwd->slottype = type; + bo_fwd->predicate = predicate; sym->declared_special = 1; sym->redirect = SYMBOL_FORWARDED; { @@ -5661,7 +5639,7 @@ Decimal digits after the % specify field width to which to pad. */); doc: /* Value of `major-mode' for new buffers. */); DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode), - make_number (Lisp_Symbol), + Qsymbolp, doc: /* Symbol for current buffer's major mode. The default value (normally `fundamental-mode') affects new buffers. A value of nil means to use the current buffer's major mode, provided @@ -5692,17 +5670,17 @@ Use the command `abbrev-mode' to change this variable. */); doc: /* Non-nil if searches and matches should ignore case. */); DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column), - make_number (Lisp_Int0), + Qintegerp, doc: /* Column beyond which automatic line-wrapping should happen. Interactively, you can set the buffer local value using \\[set-fill-column]. */); DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin), - make_number (Lisp_Int0), + Qintegerp, doc: /* Column for the default `indent-line-function' to indent to. Linefeed indents to this column in Fundamental mode. */); DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width), - make_number (Lisp_Int0), + Qintegerp, doc: /* Distance between tab stops (for display of tab characters), in columns. This should be an integer greater than zero. */); @@ -5787,7 +5765,7 @@ visual lines rather than logical lines. See the documentation of `visual-line-mode'. */); DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory), - make_number (Lisp_String), + Qstringp, doc: /* Name of default directory of current buffer. Should end with slash. To interactively change the default directory, use command `cd'. */); @@ -5800,18 +5778,18 @@ NOTE: This variable is not a hook; its value may not be a list of functions. */); DEFVAR_PER_BUFFER ("buffer-file-name", &BVAR (current_buffer, filename), - make_number (Lisp_String), + Qstringp, doc: /* Name of file visited in current buffer, or nil if not visiting a file. */); DEFVAR_PER_BUFFER ("buffer-file-truename", &BVAR (current_buffer, file_truename), - make_number (Lisp_String), + Qstringp, doc: /* Abbreviated truename of file visited in current buffer, or nil if none. The truename of a file is calculated by `file-truename' and then abbreviated with `abbreviate-file-name'. */); DEFVAR_PER_BUFFER ("buffer-auto-save-file-name", &BVAR (current_buffer, auto_save_file_name), - make_number (Lisp_String), + Qstringp, doc: /* Name of file for auto-saving current buffer. If it is nil, that means don't auto-save this buffer. */); @@ -5823,7 +5801,7 @@ If it is nil, that means don't auto-save this buffer. */); Backing up is done before the first time the file is saved. */); DEFVAR_PER_BUFFER ("buffer-saved-size", &BVAR (current_buffer, save_length), - make_number (Lisp_Int0), + Qintegerp, doc: /* Length of current buffer when last read in, saved or auto-saved. 0 initially. -1 means auto-saving turned off until next real save. @@ -5893,23 +5871,23 @@ In addition, a char-table has six extra slots to control the display of: See also the functions `display-table-slot' and `set-display-table-slot'. */); DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols), - Qnil, + Qintegerp, doc: /* Width of left marginal area for display of a buffer. A value of nil means no marginal area. */); DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols), - Qnil, + Qintegerp, doc: /* Width of right marginal area for display of a buffer. A value of nil means no marginal area. */); DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width), - Qnil, + Qintegerp, doc: /* Width of this buffer's left fringe (in pixels). A value of 0 means no left fringe is shown in this buffer's window. A value of nil means to use the left fringe width from the window's frame. */); DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width), - Qnil, + Qintegerp, doc: /* Width of this buffer's right fringe (in pixels). A value of 0 means no right fringe is shown in this buffer's window. A value of nil means to use the right fringe width from the window's frame. */); @@ -5920,7 +5898,7 @@ A value of nil means to use the right fringe width from the window's frame. */) A value of nil means to display fringes between margins and buffer text. */); DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width), - Qnil, + Qintegerp, doc: /* Width of this buffer's scroll bars in pixels. A value of nil means to use the scroll bar width from the window's frame. */); @@ -6000,7 +5978,7 @@ BITMAP is the corresponding fringe bitmap shown for the logical cursor type. */); DEFVAR_PER_BUFFER ("scroll-up-aggressively", - &BVAR (current_buffer, scroll_up_aggressively), Qnil, + &BVAR (current_buffer, scroll_up_aggressively), Qfloatp, doc: /* How far to scroll windows upward. If you move point off the bottom, the window scrolls automatically. This variable controls how far it scrolls. The value nil, the default, @@ -6013,7 +5991,7 @@ window scrolls by a full window height. Meaningful values are between 0.0 and 1.0, inclusive. */); DEFVAR_PER_BUFFER ("scroll-down-aggressively", - &BVAR (current_buffer, scroll_down_aggressively), Qnil, + &BVAR (current_buffer, scroll_down_aggressively), Qfloatp, doc: /* How far to scroll windows downward. If you move point off the top, the window scrolls automatically. This variable controls how far it scrolls. The value nil, the default, @@ -6167,7 +6145,7 @@ then characters with property value PROP are invisible, and they have an ellipsis as well if ELLIPSIS is non-nil. */); DEFVAR_PER_BUFFER ("buffer-display-count", - &BVAR (current_buffer, display_count), Qnil, + &BVAR (current_buffer, display_count), Qintegerp, doc: /* A number incremented each time this buffer is displayed in a window. The function `set-window-buffer' increments it. */); @@ -6226,7 +6204,7 @@ cursor's appearance is instead controlled by the variable `cursor-in-non-selected-windows'. */); DEFVAR_PER_BUFFER ("line-spacing", - &BVAR (current_buffer, extra_line_spacing), Qnil, + &BVAR (current_buffer, extra_line_spacing), Qnumberp, doc: /* Additional space to put between lines when displaying a buffer. The space is measured in pixels, and put below lines on graphic displays, see `display-graphic-p'. diff --git a/src/buffer.h b/src/buffer.h index ec9c34b3eb..b4cc21d675 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -1078,7 +1078,6 @@ extern void set_buffer_internal_1 (struct buffer *); extern void set_buffer_temp (struct buffer *); extern Lisp_Object buffer_local_value_1 (Lisp_Object, Lisp_Object); extern void record_buffer (Lisp_Object); -extern _Noreturn void buffer_slot_type_mismatch (Lisp_Object, int); extern void fix_overlays_before (struct buffer *, ptrdiff_t, ptrdiff_t); extern void mmap_set_vars (bool); diff --git a/src/data.c b/src/data.c index 50dc188684..6622088b64 100644 --- a/src/data.c +++ b/src/data.c @@ -914,13 +914,11 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva case Lisp_Fwd_Buffer_Obj: { int offset = XBUFFER_OBJFWD (valcontents)->offset; - Lisp_Object type = XBUFFER_OBJFWD (valcontents)->slottype; + Lisp_Object predicate = XBUFFER_OBJFWD (valcontents)->predicate; - if (!(NILP (type) || NILP (newval) - || (XINT (type) == Lisp_Int0 - ? INTEGERP (newval) - : XTYPE (newval) == XINT (type)))) - buffer_slot_type_mismatch (newval, XINT (type)); + if (!NILP (predicate) && !NILP (newval) + && NILP (call1 (predicate, newval))) + wrong_type_argument (predicate, newval); if (buf == NULL) buf = current_buffer; diff --git a/src/lisp.h b/src/lisp.h index a0dcc9ab5f..8db61d3623 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1450,7 +1450,8 @@ struct Lisp_Buffer_Objfwd { enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Buffer_Obj */ int offset; - Lisp_Object slottype; /* Qnil, Lisp_Int, Lisp_Symbol, or Lisp_String. */ + /* One of Qnil, Qintegerp, Qsymbolp, Qstringp, Qfloatp or Qnumberp. */ + Lisp_Object predicate; }; /* struct Lisp_Buffer_Local_Value is used in a symbol value cell when -- 2.20.1