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 4fb688aed16350fa23595bb8d4fcbd9926fe4f9d..3561cca4ac3720c13d323080875e079a0db62945 100644 (file)
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,23 @@
+2014-07-16  Dmitry Antipov  <dmantipov@yandex.ru>
+
+       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  <ueno@gnu.org>
 
        * nsgui.h (XCHAR2B_BYTE1): Add missing parentheses around

diff --git a/src/buffer.c b/src/buffer.c
index d6f6b2c7703f600245232f5c14f0baaa48174cde..53cc25e2c8f1a665428651ee43cd4e42df23c3a7 100644 (file)
--- 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 5c1e1bb278c18cea16dde342b8bad7d9bdaf1c8c..3c29019554cd09a42f320961919b23f568854873 100644 (file)
--- 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 2de1c19452c53c444839b7ba62b8386706c84c71..790d0fee9813886ee1fbf8b64d433f81eec57a20 100644 (file)
--- 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 0ccc0f6fcfd6ea465b2da50c18c10218fa6eb837..57270437d9f24d21c02474d7648d8889acbf72e8 100644 (file)
--- 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 4fb98278a51ab10fe28391b50c3c10124376eb35..6841143f8daf79d7bfdaec4afdf1c75edf80e5fd 100644 (file)
--- 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 8614fe57cb253c8f69328a48d62a3157f94bdab2..75d5c5aa680943c8ce12316a4061ee68aeb8792b 100644 (file)
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -30,6 +30,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #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 936d6687908dc19476811fef57238e8fdd35e755..8fe6926a17c511c70fcef088f56848807088c5d1 100644 (file)
--- 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 b49aec43b65ed7a13456380b1242c3f213481604..8f1a45d03f1279ceeb9f5ca37a19db2f3f75d867 100644 (file)
--- 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 3a570628cbede30aad2bdee10c4127348eb41a9a..9420031645d16d27b6cd30c0f8fc430b3d9e055c 100644 (file)
--- 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;