/[emacs]/emacs/src/data.c
ViewVC logotype

Diff of /emacs/src/data.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.210 by raeburn, Mon May 20 08:05:21 2002 UTC revision 1.210.2.1 by miles, Fri Apr 4 06:20:57 2003 UTC
# Line 1  Line 1 
1  /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.  /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
2     Copyright (C) 1985,86,88,93,94,95,97,98,99, 2000, 2001     Copyright (C) 1985,86,88,93,94,95,97,98,99, 2000, 2001, 2003
3     Free Software Foundation, Inc.     Free Software Foundation, Inc.
4    
5  This file is part of GNU Emacs.  This file is part of GNU Emacs.
# Line 311  interned in the initial obarray.  */) Line 311  interned in the initial obarray.  */)
311       Lisp_Object object;       Lisp_Object object;
312  {  {
313    if (SYMBOLP (object)    if (SYMBOLP (object)
314        && XSTRING (SYMBOL_NAME (object))->data[0] == ':'        && SREF (SYMBOL_NAME (object), 0) == ':'
315        && SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (object))        && SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (object))
316      return Qt;      return Qt;
317    return Qnil;    return Qnil;
# Line 628  DEFUN ("fboundp", Ffboundp, Sfboundp, 1, Line 628  DEFUN ("fboundp", Ffboundp, Sfboundp, 1,
628  }  }
629    
630  DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,  DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
631         doc: /* Make SYMBOL's value be void.  */)         doc: /* Make SYMBOL's value be void.
632    Return SYMBOL.  */)
633       (symbol)       (symbol)
634       register Lisp_Object symbol;       register Lisp_Object symbol;
635  {  {
# Line 640  DEFUN ("makunbound", Fmakunbound, Smakun Line 641  DEFUN ("makunbound", Fmakunbound, Smakun
641  }  }
642    
643  DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,  DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
644         doc: /* Make SYMBOL's function definition be void.  */)         doc: /* Make SYMBOL's function definition be void.
645    Return SYMBOL.  */)
646       (symbol)       (symbol)
647       register Lisp_Object symbol;       register Lisp_Object symbol;
648  {  {
# Line 704  DEFUN ("fset", Ffset, Sfset, 2, 2, 0, Line 706  DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
706    return definition;    return definition;
707  }  }
708    
709  DEFUN ("defalias", Fdefalias, Sdefalias, 2, 2, 0,  extern Lisp_Object Qfunction_documentation;
710    
711    DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0,
712         doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.         doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.
713  Associates the function with the current load file, if any.  */)  Associates the function with the current load file, if any.
714       (symbol, definition)  The optional third argument DOCSTRING specifies the documentation string
715       register Lisp_Object symbol, definition;  for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string
716  {  determined by DEFINITION.  */)
717         (symbol, definition, docstring)
718         register Lisp_Object symbol, definition, docstring;
719    {
720      if (CONSP (XSYMBOL (symbol)->function)
721          && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
722        LOADHIST_ATTACH (Fcons (Qt, symbol));
723    definition = Ffset (symbol, definition);    definition = Ffset (symbol, definition);
724    LOADHIST_ATTACH (symbol);    LOADHIST_ATTACH (symbol);
725      if (!NILP (docstring))
726        Fput (symbol, Qfunction_documentation, docstring);
727    return definition;    return definition;
728  }  }
729    
# Line 783  indirect_variable (symbol) Line 795  indirect_variable (symbol)
795        hare = XSYMBOL (hare)->value;        hare = XSYMBOL (hare)->value;
796        if (!XSYMBOL (hare)->indirect_variable)        if (!XSYMBOL (hare)->indirect_variable)
797          break;          break;
798          
799        hare = XSYMBOL (hare)->value;        hare = XSYMBOL (hare)->value;
800        tortoise = XSYMBOL (tortoise)->value;        tortoise = XSYMBOL (tortoise)->value;
801    
# Line 869  store_symval_forwarding (symbol, valcont Line 881  store_symval_forwarding (symbol, valcont
881            *XINTFWD (valcontents)->intvar = XINT (newval);            *XINTFWD (valcontents)->intvar = XINT (newval);
882            if (*XINTFWD (valcontents)->intvar != XINT (newval))            if (*XINTFWD (valcontents)->intvar != XINT (newval))
883              error ("Value out of range for variable `%s'",              error ("Value out of range for variable `%s'",
884                     XSTRING (SYMBOL_NAME (symbol))->data);                     SDATA (SYMBOL_NAME (symbol)));
885            break;            break;
886    
887          case Lisp_Misc_Boolfwd:          case Lisp_Misc_Boolfwd:
# Line 886  store_symval_forwarding (symbol, valcont Line 898  store_symval_forwarding (symbol, valcont
898              Lisp_Object type;              Lisp_Object type;
899    
900              type = PER_BUFFER_TYPE (offset);              type = PER_BUFFER_TYPE (offset);
             if (XINT (type) == -1)  
               error ("Variable %s is read-only", XSTRING (SYMBOL_NAME (symbol))->data);  
   
901              if (! NILP (type) && ! NILP (newval)              if (! NILP (type) && ! NILP (newval)
902                  && XTYPE (newval) != XINT (type))                  && XTYPE (newval) != XINT (type))
903                buffer_slot_type_mismatch (offset);                buffer_slot_type_mismatch (offset);
# Line 931  swap_in_global_binding (symbol) Line 940  swap_in_global_binding (symbol)
940       Lisp_Object symbol;       Lisp_Object symbol;
941  {  {
942    Lisp_Object valcontents, cdr;    Lisp_Object valcontents, cdr;
943      
944    valcontents = SYMBOL_VALUE (symbol);    valcontents = SYMBOL_VALUE (symbol);
945    if (!BUFFER_LOCAL_VALUEP (valcontents)    if (!BUFFER_LOCAL_VALUEP (valcontents)
946        && !SOME_BUFFER_LOCAL_VALUEP (valcontents))        && !SOME_BUFFER_LOCAL_VALUEP (valcontents))
# Line 941  swap_in_global_binding (symbol) Line 950  swap_in_global_binding (symbol)
950    /* Unload the previously loaded binding.  */    /* Unload the previously loaded binding.  */
951    Fsetcdr (XCAR (cdr),    Fsetcdr (XCAR (cdr),
952             do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));             do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));
953      
954    /* Select the global binding in the symbol.  */    /* Select the global binding in the symbol.  */
955    XSETCAR (cdr, cdr);    XSETCAR (cdr, cdr);
956    store_symval_forwarding (symbol, valcontents, XCDR (cdr), NULL);    store_symval_forwarding (symbol, valcontents, XCDR (cdr), NULL);
# Line 965  swap_in_symval_forwarding (symbol, valco Line 974  swap_in_symval_forwarding (symbol, valco
974       Lisp_Object symbol, valcontents;       Lisp_Object symbol, valcontents;
975  {  {
976    register Lisp_Object tem1;    register Lisp_Object tem1;
977      
978    tem1 = XBUFFER_LOCAL_VALUE (valcontents)->buffer;    tem1 = XBUFFER_LOCAL_VALUE (valcontents)->buffer;
979    
980    if (NILP (tem1)    if (NILP (tem1)
# Line 975  swap_in_symval_forwarding (symbol, valco Line 984  swap_in_symval_forwarding (symbol, valco
984      {      {
985        if (XSYMBOL (symbol)->indirect_variable)        if (XSYMBOL (symbol)->indirect_variable)
986          symbol = indirect_variable (symbol);          symbol = indirect_variable (symbol);
987          
988        /* Unload the previously loaded binding.  */        /* Unload the previously loaded binding.  */
989        tem1 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);        tem1 = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);
990        Fsetcdr (tem1,        Fsetcdr (tem1,
# Line 1019  find_symbol_value (symbol) Line 1028  find_symbol_value (symbol)
1028  {  {
1029    register Lisp_Object valcontents;    register Lisp_Object valcontents;
1030    register Lisp_Object val;    register Lisp_Object val;
1031      
1032    CHECK_SYMBOL (symbol);    CHECK_SYMBOL (symbol);
1033    valcontents = SYMBOL_VALUE (symbol);    valcontents = SYMBOL_VALUE (symbol);
1034    
# Line 1132  set_internal (symbol, newval, buf, bindf Line 1141  set_internal (symbol, newval, buf, bindf
1141      return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));      return Fsignal (Qsetting_constant, Fcons (symbol, Qnil));
1142    
1143    innercontents = valcontents = SYMBOL_VALUE (symbol);    innercontents = valcontents = SYMBOL_VALUE (symbol);
1144      
1145    if (BUFFER_OBJFWDP (valcontents))    if (BUFFER_OBJFWDP (valcontents))
1146      {      {
1147        int offset = XBUFFER_OBJFWD (valcontents)->offset;        int offset = XBUFFER_OBJFWD (valcontents)->offset;
# Line 1209  set_internal (symbol, newval, buf, bindf Line 1218  set_internal (symbol, newval, buf, bindf
1218                   and load that binding.  */                   and load that binding.  */
1219                else                else
1220                  {                  {
1221                    tem1 = Fcons (symbol, Fcdr (current_alist_element));                    tem1 = Fcons (symbol, XCDR (current_alist_element));
1222                    buf->local_var_alist                    buf->local_var_alist
1223                      = Fcons (tem1, buf->local_var_alist);                      = Fcons (tem1, buf->local_var_alist);
1224                  }                  }
# Line 1355  for this variable.  */) Line 1364  for this variable.  */)
1364        if (idx > 0)        if (idx > 0)
1365          {          {
1366            struct buffer *b;            struct buffer *b;
1367              
1368            for (b = all_buffers; b; b = b->next)            for (b = all_buffers; b; b = b->next)
1369              if (!PER_BUFFER_VALUE_P (b, idx))              if (!PER_BUFFER_VALUE_P (b, idx))
1370                PER_BUFFER_VALUE (b, offset) = value;                PER_BUFFER_VALUE (b, offset) = value;
# Line 1385  for this variable.  */) Line 1394  for this variable.  */)
1394  DEFUN ("setq-default", Fsetq_default, Ssetq_default, 2, UNEVALLED, 0,  DEFUN ("setq-default", Fsetq_default, Ssetq_default, 2, UNEVALLED, 0,
1395         doc: /* Set the default value of variable VAR to VALUE.         doc: /* Set the default value of variable VAR to VALUE.
1396  VAR, the variable name, is literal (not evaluated);  VAR, the variable name, is literal (not evaluated);
1397  VALUE is an expression and it is evaluated.  VALUE is an expression: it is evaluated and its value returned.
1398  The default value of a variable is seen in buffers  The default value of a variable is seen in buffers
1399  that do not have their own values for the variable.  that do not have their own values for the variable.
1400    
# Line 1411  usage: (setq-default SYMBOL VALUE [SYMBO Line 1420  usage: (setq-default SYMBOL VALUE [SYMBO
1420    do    do
1421      {      {
1422        val = Feval (Fcar (Fcdr (args_left)));        val = Feval (Fcar (Fcdr (args_left)));
1423        symbol = Fcar (args_left);        symbol = XCAR (args_left);
1424        Fset_default (symbol, val);        Fset_default (symbol, val);
1425        args_left = Fcdr (Fcdr (args_left));        args_left = Fcdr (XCDR (args_left));
1426      }      }
1427    while (!NILP (args_left));    while (!NILP (args_left));
1428    
# Line 1431  unless the variable has never been set i Line 1440  unless the variable has never been set i
1440  in which case the default value is in effect.  in which case the default value is in effect.
1441  Note that binding the variable with `let', or setting it while  Note that binding the variable with `let', or setting it while
1442  a `let'-style binding made in this buffer is in effect,  a `let'-style binding made in this buffer is in effect,
1443  does not make the variable buffer-local.  does not make the variable buffer-local.  Return VARIABLE.
1444    
1445  The function `default-value' gets the default value and `set-default' sets it.  */)  The function `default-value' gets the default value and `set-default' sets it.  */)
1446       (variable)       (variable)
# Line 1443  The function `default-value' gets the de Line 1452  The function `default-value' gets the de
1452    
1453    valcontents = SYMBOL_VALUE (variable);    valcontents = SYMBOL_VALUE (variable);
1454    if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents))    if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents))
1455      error ("Symbol %s may not be buffer-local", XSTRING (SYMBOL_NAME (variable))->data);      error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
1456    
1457    if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents))    if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents))
1458      return variable;      return variable;
# Line 1475  DEFUN ("make-local-variable", Fmake_loca Line 1484  DEFUN ("make-local-variable", Fmake_loca
1484  Other buffers will continue to share a common default value.  Other buffers will continue to share a common default value.
1485  \(The buffer-local value of VARIABLE starts out as the same value  \(The buffer-local value of VARIABLE starts out as the same value
1486  VARIABLE previously had.  If VARIABLE was void, it remains void.\)  VARIABLE previously had.  If VARIABLE was void, it remains void.\)
1487  See also `make-variable-buffer-local'.  See also `make-variable-buffer-local'.  Return VARIABLE.
1488    
1489  If the variable is already arranged to become local when set,  If the variable is already arranged to become local when set,
1490  this function causes a local value to exist for this buffer,  this function causes a local value to exist for this buffer,
# Line 1496  Instead, use `add-hook' and specify t fo Line 1505  Instead, use `add-hook' and specify t fo
1505    
1506    valcontents = SYMBOL_VALUE (variable);    valcontents = SYMBOL_VALUE (variable);
1507    if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents))    if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents))
1508      error ("Symbol %s may not be buffer-local", XSTRING (SYMBOL_NAME (variable))->data);      error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
1509    
1510    if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents))    if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents))
1511      {      {
# Line 1565  Instead, use `add-hook' and specify t fo Line 1574  Instead, use `add-hook' and specify t fo
1574  DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable,  DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable,
1575         1, 1, "vKill Local Variable: ",         1, 1, "vKill Local Variable: ",
1576         doc: /* Make VARIABLE no longer have a separate value in the current buffer.         doc: /* Make VARIABLE no longer have a separate value in the current buffer.
1577  From now on the default value will apply in this buffer.  */)  From now on the default value will apply in this buffer.  Return VARIABLE.  */)
1578       (variable)       (variable)
1579       register Lisp_Object variable;       register Lisp_Object variable;
1580  {  {
# Line 1604  From now on the default value will apply Line 1613  From now on the default value will apply
1613       loaded, recompute its value.  We have to do it now, or else       loaded, recompute its value.  We have to do it now, or else
1614       forwarded objects won't work right.  */       forwarded objects won't work right.  */
1615    {    {
1616      Lisp_Object *pvalbuf;      Lisp_Object *pvalbuf, buf;
1617      valcontents = SYMBOL_VALUE (variable);      valcontents = SYMBOL_VALUE (variable);
1618      pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;      pvalbuf = &XBUFFER_LOCAL_VALUE (valcontents)->buffer;
1619      if (current_buffer == XBUFFER (*pvalbuf))      XSETBUFFER (buf, current_buffer);
1620        if (EQ (buf, *pvalbuf))
1621        {        {
1622          *pvalbuf = Qnil;          *pvalbuf = Qnil;
1623          XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;          XBUFFER_LOCAL_VALUE (valcontents)->found_for_buffer = 0;
# Line 1625  DEFUN ("make-variable-frame-local", Fmak Line 1635  DEFUN ("make-variable-frame-local", Fmak
1635         doc: /* Enable VARIABLE to have frame-local bindings.         doc: /* Enable VARIABLE to have frame-local bindings.
1636  When a frame-local binding exists in the current frame,  When a frame-local binding exists in the current frame,
1637  it is in effect whenever the current buffer has no buffer-local binding.  it is in effect whenever the current buffer has no buffer-local binding.
1638  A frame-local binding is actual a frame parameter value;  A frame-local binding is actually a frame parameter value;
1639  thus, any given frame has a local binding for VARIABLE  thus, any given frame has a local binding for VARIABLE if it has
1640  if it has a value for the frame parameter named VARIABLE.  a value for the frame parameter named VARIABLE.  Return VARIABLE.
1641  See `modify-frame-parameters'.  */)  See `modify-frame-parameters' for how to set frame parameters.  */)
1642       (variable)       (variable)
1643       register Lisp_Object variable;       register Lisp_Object variable;
1644  {  {
# Line 1639  See `modify-frame-parameters'.  */) Line 1649  See `modify-frame-parameters'.  */)
1649    valcontents = SYMBOL_VALUE (variable);    valcontents = SYMBOL_VALUE (variable);
1650    if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)    if (EQ (variable, Qnil) || EQ (variable, Qt) || KBOARD_OBJFWDP (valcontents)
1651        || BUFFER_OBJFWDP (valcontents))        || BUFFER_OBJFWDP (valcontents))
1652      error ("Symbol %s may not be frame-local", XSTRING (SYMBOL_NAME (variable))->data);      error ("Symbol %s may not be frame-local", SDATA (SYMBOL_NAME (variable)));
1653    
1654    if (BUFFER_LOCAL_VALUEP (valcontents)    if (BUFFER_LOCAL_VALUEP (valcontents)
1655        || SOME_BUFFER_LOCAL_VALUEP (valcontents))        || SOME_BUFFER_LOCAL_VALUEP (valcontents))
# Line 1823  or a byte-code object.  IDX starts at 0. Line 1833  or a byte-code object.  IDX starts at 0.
1833      {      {
1834        int c, idxval_byte;        int c, idxval_byte;
1835    
1836        if (idxval < 0 || idxval >= XSTRING (array)->size)        if (idxval < 0 || idxval >= SCHARS (array))
1837          args_out_of_range (array, idx);          args_out_of_range (array, idx);
1838        if (! STRING_MULTIBYTE (array))        if (! STRING_MULTIBYTE (array))
1839          return make_number ((unsigned char) XSTRING (array)->data[idxval]);          return make_number ((unsigned char) SREF (array, idxval));
1840        idxval_byte = string_char_to_byte (array, idxval);        idxval_byte = string_char_to_byte (array, idxval);
1841    
1842        c = STRING_CHAR (&XSTRING (array)->data[idxval_byte],        c = STRING_CHAR (SDATA (array) + idxval_byte,
1843                         STRING_BYTES (XSTRING (array)) - idxval_byte);                         SBYTES (array) - idxval_byte);
1844        return make_number (c);        return make_number (c);
1845      }      }
1846    else if (BOOL_VECTOR_P (array))    else if (BOOL_VECTOR_P (array))
# Line 1940  or a byte-code object.  IDX starts at 0. Line 1950  or a byte-code object.  IDX starts at 0.
1950    
1951  DEFUN ("aset", Faset, Saset, 3, 3, 0,  DEFUN ("aset", Faset, Saset, 3, 3, 0,
1952         doc: /* Store into the element of ARRAY at index IDX the value NEWELT.         doc: /* Store into the element of ARRAY at index IDX the value NEWELT.
1953  ARRAY may be a vector, a string, a char-table or a bool-vector.  Return NEWELT.  ARRAY may be a vector, a string, a char-table or a
1954  IDX starts at 0.  */)  bool-vector.  IDX starts at 0.  */)
1955       (array, idx, newelt)       (array, idx, newelt)
1956       register Lisp_Object array;       register Lisp_Object array;
1957       Lisp_Object idx, newelt;       Lisp_Object idx, newelt;
# Line 2022  IDX starts at 0.  */) Line 2032  IDX starts at 0.  */)
2032        int idxval_byte, prev_bytes, new_bytes;        int idxval_byte, prev_bytes, new_bytes;
2033        unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;        unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
2034    
2035        if (idxval < 0 || idxval >= XSTRING (array)->size)        if (idxval < 0 || idxval >= SCHARS (array))
2036          args_out_of_range (array, idx);          args_out_of_range (array, idx);
2037        CHECK_NUMBER (newelt);        CHECK_NUMBER (newelt);
2038    
2039        idxval_byte = string_char_to_byte (array, idxval);        idxval_byte = string_char_to_byte (array, idxval);
2040        p1 = &XSTRING (array)->data[idxval_byte];        p1 = SDATA (array) + idxval_byte;
2041        PARSE_MULTIBYTE_SEQ (p1, nbytes - idxval_byte, prev_bytes);        PARSE_MULTIBYTE_SEQ (p1, nbytes - idxval_byte, prev_bytes);
2042        new_bytes = CHAR_STRING (XINT (newelt), p0);        new_bytes = CHAR_STRING (XINT (newelt), p0);
2043        if (prev_bytes != new_bytes)        if (prev_bytes != new_bytes)
2044          {          {
2045            /* We must relocate the string data.  */            /* We must relocate the string data.  */
2046            int nchars = XSTRING (array)->size;            int nchars = SCHARS (array);
2047            int nbytes = STRING_BYTES (XSTRING (array));            int nbytes = SBYTES (array);
2048            unsigned char *str;            unsigned char *str;
2049    
2050            str = (nbytes <= MAX_ALLOCA            str = (nbytes <= MAX_ALLOCA
2051                   ? (unsigned char *) alloca (nbytes)                   ? (unsigned char *) alloca (nbytes)
2052                   : (unsigned char *) xmalloc (nbytes));                   : (unsigned char *) xmalloc (nbytes));
2053            bcopy (XSTRING (array)->data, str, nbytes);            bcopy (SDATA (array), str, nbytes);
2054            allocate_string_data (XSTRING (array), nchars,            allocate_string_data (XSTRING (array), nchars,
2055                                  nbytes + new_bytes - prev_bytes);                                  nbytes + new_bytes - prev_bytes);
2056            bcopy (str, XSTRING (array)->data, idxval_byte);            bcopy (str, SDATA (array), idxval_byte);
2057            p1 = XSTRING (array)->data + idxval_byte;            p1 = SDATA (array) + idxval_byte;
2058            bcopy (str + idxval_byte + prev_bytes, p1 + new_bytes,            bcopy (str + idxval_byte + prev_bytes, p1 + new_bytes,
2059                   nbytes - (idxval_byte + prev_bytes));                   nbytes - (idxval_byte + prev_bytes));
2060            if (nbytes > MAX_ALLOCA)            if (nbytes > MAX_ALLOCA)
# Line 2056  IDX starts at 0.  */) Line 2066  IDX starts at 0.  */)
2066      }      }
2067    else    else
2068      {      {
2069        if (idxval < 0 || idxval >= XSTRING (array)->size)        if (idxval < 0 || idxval >= SCHARS (array))
2070          args_out_of_range (array, idx);          args_out_of_range (array, idx);
2071        CHECK_NUMBER (newelt);        CHECK_NUMBER (newelt);
2072    
2073        if (XINT (newelt) < 0 || SINGLE_BYTE_CHAR_P (XINT (newelt)))        if (XINT (newelt) < 0 || SINGLE_BYTE_CHAR_P (XINT (newelt)))
2074          XSTRING (array)->data[idxval] = XINT (newelt);          SSET (array, idxval, XINT (newelt));
2075        else        else
2076          {          {
2077            /* We must relocate the string data while converting it to            /* We must relocate the string data while converting it to
2078               multibyte.  */               multibyte.  */
2079            int idxval_byte, prev_bytes, new_bytes;            int idxval_byte, prev_bytes, new_bytes;
2080            unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;            unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
2081            unsigned char *origstr = XSTRING (array)->data, *str;            unsigned char *origstr = SDATA (array), *str;
2082            int nchars, nbytes;            int nchars, nbytes;
2083    
2084            nchars = XSTRING (array)->size;            nchars = SCHARS (array);
2085            nbytes = idxval_byte = count_size_as_multibyte (origstr, idxval);            nbytes = idxval_byte = count_size_as_multibyte (origstr, idxval);
2086            nbytes += count_size_as_multibyte (origstr + idxval,            nbytes += count_size_as_multibyte (origstr + idxval,
2087                                               nchars - idxval);                                               nchars - idxval);
2088            str = (nbytes <= MAX_ALLOCA            str = (nbytes <= MAX_ALLOCA
2089                   ? (unsigned char *) alloca (nbytes)                   ? (unsigned char *) alloca (nbytes)
2090                   : (unsigned char *) xmalloc (nbytes));                   : (unsigned char *) xmalloc (nbytes));
2091            copy_text (XSTRING (array)->data, str, nchars, 0, 1);            copy_text (SDATA (array), str, nchars, 0, 1);
2092            PARSE_MULTIBYTE_SEQ (str + idxval_byte, nbytes - idxval_byte,            PARSE_MULTIBYTE_SEQ (str + idxval_byte, nbytes - idxval_byte,
2093                                 prev_bytes);                                 prev_bytes);
2094            new_bytes = CHAR_STRING (XINT (newelt), p0);            new_bytes = CHAR_STRING (XINT (newelt), p0);
2095            allocate_string_data (XSTRING (array), nchars,            allocate_string_data (XSTRING (array), nchars,
2096                                  nbytes + new_bytes - prev_bytes);                                  nbytes + new_bytes - prev_bytes);
2097            bcopy (str, XSTRING (array)->data, idxval_byte);            bcopy (str, SDATA (array), idxval_byte);
2098            p1 = XSTRING (array)->data + idxval_byte;            p1 = SDATA (array) + idxval_byte;
2099            while (new_bytes--)            while (new_bytes--)
2100              *p1++ = *p0++;              *p1++ = *p0++;
2101            bcopy (str + idxval_byte + prev_bytes, p1,            bcopy (str + idxval_byte + prev_bytes, p1,
# Line 2233  Lisp_Object Line 2243  Lisp_Object
2243  long_to_cons (i)  long_to_cons (i)
2244       unsigned long i;       unsigned long i;
2245  {  {
2246    unsigned int top = i >> 16;    unsigned long top = i >> 16;
2247    unsigned int bot = i & 0xFFFF;    unsigned int bot = i & 0xFFFF;
2248    if (top == 0)    if (top == 0)
2249      return make_number (bot);      return make_number (bot);
# Line 2257  cons_to_long (c) Line 2267  cons_to_long (c)
2267  }  }
2268    
2269  DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0,  DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0,
2270         doc: /* Convert NUMBER to a string by printing it in decimal.         doc: /* Return the decimal representation of NUMBER as a string.
2271  Uses a minus sign if negative.  Uses a minus sign if negative.
2272  NUMBER may be an integer or a floating point number.  */)  NUMBER may be an integer or a floating point number.  */)
2273       (number)       (number)
# Line 2303  digit_to_number (character, base) Line 2313  digit_to_number (character, base)
2313      return -1;      return -1;
2314    else    else
2315      return digit;      return digit;
2316  }      }
2317    
2318  DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0,  DEFUN ("string-to-number", Fstring_to_number, Sstring_to_number, 1, 2, 0,
2319         doc: /* Convert STRING to a number by parsing it as a decimal number.         doc: /* Parse STRING as a decimal number and return the number.
2320  This parses both integers and floating point numbers.  This parses both integers and floating point numbers.
2321  It ignores leading spaces and tabs.  It ignores leading spaces and tabs.
2322    
# Line 2335  If the base used is not 10, floating poi Line 2345  If the base used is not 10, floating poi
2345    
2346    /* Skip any whitespace at the front of the number.  Some versions of    /* Skip any whitespace at the front of the number.  Some versions of
2347       atoi do this anyway, so we might as well make Emacs lisp consistent.  */       atoi do this anyway, so we might as well make Emacs lisp consistent.  */
2348    p = XSTRING (string)->data;    p = SDATA (string);
2349    while (*p == ' ' || *p == '\t')    while (*p == ' ' || *p == '\t')
2350      p++;      p++;
2351    
# Line 2346  If the base used is not 10, floating poi Line 2356  If the base used is not 10, floating poi
2356      }      }
2357    else if (*p == '+')    else if (*p == '+')
2358      p++;      p++;
2359      
2360    if (isfloat_string (p) && b == 10)    if (isfloat_string (p) && b == 10)
2361      val = make_float (sign * atof (p));      val = make_float (sign * atof (p));
2362    else    else
# Line 2549  usage: (+ &rest NUMBERS-OR-MARKERS)  */) Line 2559  usage: (+ &rest NUMBERS-OR-MARKERS)  */)
2559  }  }
2560    
2561  DEFUN ("-", Fminus, Sminus, 0, MANY, 0,  DEFUN ("-", Fminus, Sminus, 0, MANY, 0,
2562         doc: /* Negate number or subtract numbers or markers.         doc: /* Negate number or subtract numbers or markers and return the result.
2563  With one arg, negates it.  With more than one arg,  With one arg, negates it.  With more than one arg,
2564  subtracts all but the first from the first.  subtracts all but the first from the first.
2565  usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS)  */)  usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS)  */)
# Line 2735  In this case, the sign bit is duplicated Line 2745  In this case, the sign bit is duplicated
2745  DEFUN ("lsh", Flsh, Slsh, 2, 2, 0,  DEFUN ("lsh", Flsh, Slsh, 2, 2, 0,
2746         doc: /* Return VALUE with its bits shifted left by COUNT.         doc: /* Return VALUE with its bits shifted left by COUNT.
2747  If COUNT is negative, shifting is actually to the right.  If COUNT is negative, shifting is actually to the right.
2748  In this case,  zeros are shifted in on the left.  */)  In this case, zeros are shifted in on the left.  */)
2749       (value, count)       (value, count)
2750       register Lisp_Object value, count;       register Lisp_Object value, count;
2751  {  {
# Line 3202  syms_of_data () Line 3212  syms_of_data ()
3212    DEFVAR_LISP ("most-positive-fixnum", &Vmost_positive_fixnum,    DEFVAR_LISP ("most-positive-fixnum", &Vmost_positive_fixnum,
3213                 doc: /* The largest value that is representable in a Lisp integer.  */);                 doc: /* The largest value that is representable in a Lisp integer.  */);
3214    Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM);    Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM);
3215      
3216    DEFVAR_LISP ("most-negative-fixnum", &Vmost_negative_fixnum,    DEFVAR_LISP ("most-negative-fixnum", &Vmost_negative_fixnum,
3217                 doc: /* The smallest value that is representable in a Lisp integer.  */);                 doc: /* The smallest value that is representable in a Lisp integer.  */);
3218    Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);    Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);

Legend:
Removed from v.1.210  
changed lines
  Added in v.1.210.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26