From: Dmitry Antipov Date: Wed, 16 Jul 2014 08:45:22 +0000 (+0400) Subject: More precise control over values of some buffer-local variables. X-Git-Tag: emacs-25.0.90~2636^2~10 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e0b07ec3416d1ee7c77234e9dd0a7408b50da83c;p=emacs.git More precise control over values of some buffer-local variables. * keyboard.c (Qvertical_scroll_bar): * frame.c (Qleft, Qright): Move to ... * buffer.c (Qleft, Qright, Qvertical_scroll_bar): ... here. * buffer.c (Qchoice, Qrange, Qoverwrite_mode, Qfraction): New symbols. (syms_of_buffer): DEFSYM all of the above, attach special properties. Use special symbols to DEFVAR_PER_BUFFER overwrite-mode, vertical-scroll-bar, scroll-up-aggressively and scroll-down-aggressively. * buffer.h (Qchoice, Qrange, Qleft, Qright, Qvertical_scroll_bar): Add declarations. * nsfns.m, frame.h (Qleft, Qright): * nsterm.m (Qleft): Remove declarations. * gtkutil.c (toplevel): Include buffer.h. * data.c (wrong_choice, wrong_range): New functions. (store_symval_forwarding): Handle special properties of buffer-local variables and use functions from the above to signal error, if any. --- diff --git a/src/ChangeLog b/src/ChangeLog index 4fb688aed16..3561cca4ac3 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,23 @@ +2014-07-16 Dmitry Antipov + + More precise control over values of some buffer-local variables. + * keyboard.c (Qvertical_scroll_bar): + * frame.c (Qleft, Qright): Move to ... + * buffer.c (Qleft, Qright, Qvertical_scroll_bar): ... here. + * buffer.c (Qchoice, Qrange, Qoverwrite_mode, Qfraction): New symbols. + (syms_of_buffer): DEFSYM all of the above, attach special properties. + Use special symbols to DEFVAR_PER_BUFFER overwrite-mode, + vertical-scroll-bar, scroll-up-aggressively + and scroll-down-aggressively. + * buffer.h (Qchoice, Qrange, Qleft, Qright, Qvertical_scroll_bar): + Add declarations. + * nsfns.m, frame.h (Qleft, Qright): + * nsterm.m (Qleft): Remove declarations. + * gtkutil.c (toplevel): Include buffer.h. + * data.c (wrong_choice, wrong_range): New functions. + (store_symval_forwarding): Handle special properties of buffer-local + variables and use functions from the above to signal error, if any. + 2014-07-15 Daiki Ueno * nsgui.h (XCHAR2B_BYTE1): Add missing parentheses around diff --git a/src/buffer.c b/src/buffer.c index d6f6b2c7703..53cc25e2c8f 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -145,6 +145,9 @@ Lisp_Object Qmodification_hooks; Lisp_Object Qinsert_in_front_hooks; Lisp_Object Qinsert_behind_hooks; +Lisp_Object Qchoice, Qrange, Qleft, Qright, Qvertical_scroll_bar; +static Lisp_Object Qoverwrite_mode, Qfraction; + static void alloc_buffer_text (struct buffer *, ptrdiff_t); static void free_buffer_text (struct buffer *b); static struct Lisp_Overlay * copy_overlays (struct buffer *, struct Lisp_Overlay *); @@ -5422,6 +5425,10 @@ syms_of_buffer (void) staticpro (&Qpermanent_local); staticpro (&Qkill_buffer_hook); + DEFSYM (Qleft, "left"); + DEFSYM (Qright, "right"); + DEFSYM (Qrange, "range"); + DEFSYM (Qpermanent_local_hook, "permanent-local-hook"); DEFSYM (Qoverlayp, "overlayp"); DEFSYM (Qevaporate, "evaporate"); @@ -5437,6 +5444,17 @@ syms_of_buffer (void) DEFSYM (Qafter_change_functions, "after-change-functions"); DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions"); + DEFSYM (Qvertical_scroll_bar, "vertical-scroll-bar"); + Fput (Qvertical_scroll_bar, Qchoice, list4 (Qnil, Qt, Qleft, Qright)); + + DEFSYM (Qfraction, "fraction"); + Fput (Qfraction, Qrange, Fcons (make_float (0.0), make_float (1.0))); + + DEFSYM (Qoverwrite_mode, "overwrite-mode"); + Fput (Qoverwrite_mode, Qchoice, + list3 (Qnil, intern ("overwrite-mode-textual"), + intern ("overwrite-mode-binary"))); + Fput (Qprotected_field, Qerror_conditions, listn (CONSTYPE_PURE, 2, Qprotected_field, Qerror)); Fput (Qprotected_field, Qerror_message, @@ -5842,7 +5860,8 @@ in a file, save the ^M as a newline. */); Qnil, doc: /* Non-nil means display ... on previous line when a line is invisible. */); - DEFVAR_PER_BUFFER ("overwrite-mode", &BVAR (current_buffer, overwrite_mode), Qnil, + DEFVAR_PER_BUFFER ("overwrite-mode", &BVAR (current_buffer, overwrite_mode), + Qoverwrite_mode, doc: /* Non-nil if self-insertion should replace existing text. The value should be one of `overwrite-mode-textual', `overwrite-mode-binary', or nil. @@ -5936,7 +5955,7 @@ in a window. To make the change take effect, call `set-window-buffer'. */); A value of nil means to use the scroll bar width from the window's frame. */); DEFVAR_PER_BUFFER ("vertical-scroll-bar", &BVAR (current_buffer, vertical_scroll_bar_type), - Qnil, + Qvertical_scroll_bar, doc: /* Position of this buffer's vertical scroll bar. The value takes effect whenever you tell a window to display this buffer; for instance, with `set-window-buffer' or when `display-buffer' displays it. @@ -6011,7 +6030,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), Qfloatp, + &BVAR (current_buffer, scroll_up_aggressively), Qfraction, 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, @@ -6024,7 +6043,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), Qfloatp, + &BVAR (current_buffer, scroll_down_aggressively), Qfraction, 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, diff --git a/src/buffer.h b/src/buffer.h index 5c1e1bb278c..3c29019554c 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -1135,6 +1135,7 @@ extern Lisp_Object Qbefore_change_functions; extern Lisp_Object Qafter_change_functions; extern Lisp_Object Qfirst_change_hook; extern Lisp_Object Qpriority, Qbefore_string, Qafter_string; +extern Lisp_Object Qchoice, Qrange, Qleft, Qright, Qvertical_scroll_bar; /* FOR_EACH_LIVE_BUFFER (LIST_VAR, BUF_VAR) followed by a statement is a `for' loop which iterates over the buffers from Vbuffer_alist. */ diff --git a/src/data.c b/src/data.c index 2de1c19452c..790d0fee981 100644 --- a/src/data.c +++ b/src/data.c @@ -971,6 +971,48 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents) } } +/* Used to signal a user-friendly error when symbol WRONG is + not a member of CHOICE, which should be a list of symbols. */ + +static void +wrong_choice (Lisp_Object choice, Lisp_Object wrong) +{ + ptrdiff_t i = 0, len = XINT (Flength (choice)); + Lisp_Object obj, *args; + + USE_SAFE_ALLOCA; + SAFE_ALLOCA_LISP (args, len * 2 + 1); + + args[i++] = build_string ("One of "); + + for (obj = choice; !NILP (obj); obj = XCDR (obj)) + { + args[i++] = SYMBOL_NAME (XCAR (obj)); + args[i++] = build_string (NILP (XCDR (obj)) ? " should be specified" + : (NILP (XCDR (XCDR (obj))) ? " or " : ", ")); + } + + obj = Fconcat (i, args); + SAFE_FREE (); + xsignal2 (Qerror, obj, wrong); +} + +/* Used to signal a user-friendly error if WRONG is not a number or + integer/floating-point number outsize of inclusive MIN..MAX range. */ + +static void +wrong_range (Lisp_Object min, Lisp_Object max, Lisp_Object wrong) +{ + Lisp_Object args[4]; + + args[0] = build_string ("Value should be from "); + args[1] = Fnumber_to_string (min); + args[2] = build_string (" to "); + args[3] = Fnumber_to_string (max); + + xsignal2 (Qerror, Fconcat (4, args), wrong); +} + /* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell of SYMBOL. If SYMBOL is buffer-local, VALCONTENTS should be the buffer-independent contents of the value cell: forwarded just one @@ -1027,10 +1069,33 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva int offset = XBUFFER_OBJFWD (valcontents)->offset; Lisp_Object predicate = XBUFFER_OBJFWD (valcontents)->predicate; - if (!NILP (predicate) && !NILP (newval) - && NILP (call1 (predicate, newval))) - wrong_type_argument (predicate, newval); + if (!NILP (newval)) + { + if (SYMBOLP (predicate)) + { + Lisp_Object prop; + + if ((prop = Fget (predicate, Qchoice), !NILP (prop))) + { + if (NILP (Fmemq (newval, prop))) + wrong_choice (prop, newval); + } + else if ((prop = Fget (predicate, Qrange), !NILP (prop))) + { + Lisp_Object min = XCAR (prop), max = XCDR (prop); + if (!NUMBERP (newval) + || !NILP (arithcompare (newval, min, ARITH_LESS)) + || !NILP (arithcompare (newval, max, ARITH_GRTR))) + wrong_range (min, max, newval); + } + else if (FUNCTIONP (predicate)) + { + if (NILP (call1 (predicate, newval))) + wrong_type_argument (predicate, newval); + } + } + } if (buf == NULL) buf = current_buffer; set_per_buffer_value (buf, offset, newval); diff --git a/src/frame.c b/src/frame.c index 0ccc0f6fcfd..57270437d9f 100644 --- a/src/frame.c +++ b/src/frame.c @@ -78,7 +78,6 @@ Lisp_Object Qauto_raise, Qauto_lower; Lisp_Object Qborder_color, Qborder_width; Lisp_Object Qcursor_color, Qcursor_type; Lisp_Object Qheight, Qwidth; -Lisp_Object Qleft, Qright; Lisp_Object Qicon_left, Qicon_top, Qicon_type, Qicon_name; Lisp_Object Qtooltip; Lisp_Object Qinternal_border_width; @@ -4547,8 +4546,6 @@ syms_of_frame (void) DEFSYM (Qicon_left, "icon-left"); DEFSYM (Qicon_top, "icon-top"); DEFSYM (Qtooltip, "tooltip"); - DEFSYM (Qleft, "left"); - DEFSYM (Qright, "right"); DEFSYM (Quser_position, "user-position"); DEFSYM (Quser_size, "user-size"); DEFSYM (Qwindow_id, "window-id"); diff --git a/src/frame.h b/src/frame.h index 4fb98278a51..6841143f8da 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1255,7 +1255,7 @@ extern Lisp_Object Qdisplay_type; extern Lisp_Object Qx_resource_name; -extern Lisp_Object Qleft, Qright, Qtop, Qbox, Qbottom; +extern Lisp_Object Qtop, Qbox, Qbottom; extern Lisp_Object Qdisplay; extern Lisp_Object Qrun_hook_with_args; diff --git a/src/gtkutil.c b/src/gtkutil.c index 8614fe57cb2..75d5c5aa680 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -30,6 +30,7 @@ along with GNU Emacs. If not, see . */ #include "blockinput.h" #include "syssignal.h" #include "window.h" +#include "buffer.h" #include "gtkutil.h" #include "termhooks.h" #include "keyboard.h" diff --git a/src/keyboard.c b/src/keyboard.c index 936d6687908..8fe6926a17c 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -348,7 +348,6 @@ static Lisp_Object Qmodifier_cache; Lisp_Object Qmode_line; Lisp_Object Qvertical_line; Lisp_Object Qright_divider, Qbottom_divider; -static Lisp_Object Qvertical_scroll_bar; Lisp_Object Qmenu_bar; static Lisp_Object Qecho_keystrokes; @@ -11012,7 +11011,6 @@ syms_of_keyboard (void) DEFSYM (Qmode_line, "mode-line"); DEFSYM (Qvertical_line, "vertical-line"); - DEFSYM (Qvertical_scroll_bar, "vertical-scroll-bar"); DEFSYM (Qmenu_bar, "menu-bar"); DEFSYM (Qright_divider, "right-divider"); DEFSYM (Qbottom_divider, "bottom-divider"); diff --git a/src/nsfns.m b/src/nsfns.m index b49aec43b65..8f1a45d03f1 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -73,8 +73,6 @@ extern Lisp_Object Qicon_type; extern Lisp_Object Qicon_name; extern Lisp_Object Qicon_left; extern Lisp_Object Qicon_top; -extern Lisp_Object Qleft; -extern Lisp_Object Qright; extern Lisp_Object Qtop; extern Lisp_Object Qdisplay; extern Lisp_Object Qvertical_scroll_bars; diff --git a/src/nsterm.m b/src/nsterm.m index 3a570628cbe..9420031645d 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -229,7 +229,7 @@ static unsigned convert_ns_to_X_keysym[] = static Lisp_Object Qmodifier_value; Lisp_Object Qalt, Qcontrol, Qhyper, Qmeta, Qsuper; -extern Lisp_Object Qcursor_color, Qcursor_type, Qns, Qleft; +extern Lisp_Object Qcursor_color, Qcursor_type, Qns; static Lisp_Object QUTF8_STRING; static Lisp_Object Qcocoa, Qgnustep;