]> code.delx.au - gnu-emacs/blobdiff - src/fns.c
* src/macfont.m (mac_font_shape): Make sure that total_advance is increasing.
[gnu-emacs] / src / fns.c
index da74b9cb48919decb133d527f19db0ccea4a2397..270dfb41c172a0740f75916c2dc9450113d30155 100644 (file)
--- a/src/fns.c
+++ b/src/fns.c
@@ -35,7 +35,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "window.h"
 
 static void sort_vector_copy (Lisp_Object, ptrdiff_t,
-                             Lisp_Object [restrict], Lisp_Object [restrict]);
+                             Lisp_Object *restrict, Lisp_Object *restrict);
 static bool internal_equal (Lisp_Object, Lisp_Object, int, bool, Lisp_Object);
 
 DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
@@ -226,7 +226,7 @@ Like in `substring', negative values are counted from the end.
 The strings are compared by the numeric values of their characters.
 For instance, STR1 is "less than" STR2 if its first differing
 character has a smaller numeric value.  If IGNORE-CASE is non-nil,
-characters are converted to lower-case before comparing them.  Unibyte
+characters are converted to upper-case before comparing them.  Unibyte
 strings are converted to multibyte for comparison.
 
 The value is t if the strings (or specified portions) match.
@@ -2654,6 +2654,30 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string.  */)
 
   return sequence;
 }
+
+DEFUN ("mapcan", Fmapcan, Smapcan, 2, 2, 0,
+       doc: /* Apply FUNCTION to each element of SEQUENCE, and concatenate
+the results by altering them (using `nconc').
+SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
+     (Lisp_Object function, Lisp_Object sequence)
+{
+  register EMACS_INT leni;
+  register Lisp_Object *args;
+  Lisp_Object ret;
+  USE_SAFE_ALLOCA;
+
+  if (CHAR_TABLE_P (sequence))
+    wrong_type_argument (Qlistp, sequence);
+
+  leni = XFASTINT (Flength (sequence));
+  SAFE_ALLOCA_LISP (args, leni);
+  mapcar1 (leni, args, function, sequence);
+  ret = Fnconc (leni, args);
+
+  SAFE_FREE ();
+
+  return ret;
+}
 \f
 /* This is how C code calls `yes-or-no-p' and allows the user
    to redefine it.  */
@@ -2808,17 +2832,24 @@ require_unwind (Lisp_Object old_value)
 
 DEFUN ("require", Frequire, Srequire, 1, 3, 0,
        doc: /* If feature FEATURE is not loaded, load it from FILENAME.
-If FEATURE is not a member of the list `features', then the feature
-is not loaded; so load the file FILENAME.
-If FILENAME is omitted, the printname of FEATURE is used as the file name,
-and `load' will try to load this name appended with the suffix `.elc',
-`.el', or the system-dependent suffix for dynamic module files, in that
-order.  The name without appended suffix will not be used.
-See `get-load-suffixes' for the complete list of suffixes.
-If the optional third argument NOERROR is non-nil,
-then return nil if the file is not found instead of signaling an error.
-Normally the return value is FEATURE.
-The normal messages at start and end of loading FILENAME are suppressed.  */)
+If FEATURE is not a member of the list `features', then the feature is
+not loaded; so load the file FILENAME.
+
+If FILENAME is omitted, the printname of FEATURE is used as the file
+name, and `load' will try to load this name appended with the suffix
+`.elc', `.el', or the system-dependent suffix for dynamic module
+files, in that order.  The name without appended suffix will not be
+used.  See `get-load-suffixes' for the complete list of suffixes.
+
+The directories in `load-path' are searched when trying to find the
+file name.
+
+If the optional third argument NOERROR is non-nil, then return nil if
+the file is not found instead of signaling an error.  Normally the
+return value is FEATURE.
+
+The normal messages at start and end of loading FILENAME are
+suppressed.  */)
   (Lisp_Object feature, Lisp_Object filename, Lisp_Object noerror)
 {
   Lisp_Object tem;
@@ -3667,8 +3698,6 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max)
                         Low-level Functions
  ***********************************************************************/
 
-struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal;
-
 /* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
    HASH2 in hash table H using `eql'.  Value is true if KEY1 and
    KEY2 are the same.  */
@@ -3709,7 +3738,6 @@ cmpfn_user_defined (struct hash_table_test *ht,
   return !NILP (call2 (ht->user_cmp_function, key1, key2));
 }
 
-
 /* Value is a hash code for KEY for use in hash table H which uses
    `eq' to compare keys.  The hash code returned is guaranteed to fit
    in a Lisp integer.  */
@@ -3717,34 +3745,27 @@ cmpfn_user_defined (struct hash_table_test *ht,
 static EMACS_UINT
 hashfn_eq (struct hash_table_test *ht, Lisp_Object key)
 {
-  EMACS_UINT hash = XHASH (key) ^ XTYPE (key);
-  return hash;
+  return XHASH (key) ^ XTYPE (key);
 }
 
 /* Value is a hash code for KEY for use in hash table H which uses
-   `eql' to compare keys.  The hash code returned is guaranteed to fit
+   `equal' to compare keys.  The hash code returned is guaranteed to fit
    in a Lisp integer.  */
 
 static EMACS_UINT
-hashfn_eql (struct hash_table_test *ht, Lisp_Object key)
+hashfn_equal (struct hash_table_test *ht, Lisp_Object key)
 {
-  EMACS_UINT hash;
-  if (FLOATP (key))
-    hash = sxhash (key, 0);
-  else
-    hash = XHASH (key) ^ XTYPE (key);
-  return hash;
+  return sxhash (key, 0);
 }
 
 /* Value is a hash code for KEY for use in hash table H which uses
-   `equal' to compare keys.  The hash code returned is guaranteed to fit
+   `eql' to compare keys.  The hash code returned is guaranteed to fit
    in a Lisp integer.  */
 
 static EMACS_UINT
-hashfn_equal (struct hash_table_test *ht, Lisp_Object key)
+hashfn_eql (struct hash_table_test *ht, Lisp_Object key)
 {
-  EMACS_UINT hash = sxhash (key, 0);
-  return hash;
+  return FLOATP (key) ? hashfn_equal (ht, key) : hashfn_eq (ht, key);
 }
 
 /* Value is a hash code for KEY for use in hash table H which uses as
@@ -3758,6 +3779,14 @@ hashfn_user_defined (struct hash_table_test *ht, Lisp_Object key)
   return hashfn_eq (ht, hash);
 }
 
+struct hash_table_test const
+  hashtest_eq = { LISPSYM_INITIALLY (Qeq), LISPSYM_INITIALLY (Qnil),
+                 LISPSYM_INITIALLY (Qnil), 0, hashfn_eq },
+  hashtest_eql = { LISPSYM_INITIALLY (Qeql), LISPSYM_INITIALLY (Qnil),
+                  LISPSYM_INITIALLY (Qnil), cmpfn_eql, hashfn_eql },
+  hashtest_equal = { LISPSYM_INITIALLY (Qequal), LISPSYM_INITIALLY (Qnil),
+                    LISPSYM_INITIALLY (Qnil), cmpfn_equal, hashfn_equal };
+
 /* Allocate basically initialized hash table.  */
 
 static struct Lisp_Hash_Table *
@@ -4448,33 +4477,29 @@ sxhash (Lisp_Object obj, int depth)
  ***********************************************************************/
 
 DEFUN ("sxhash-eq", Fsxhash_eq, Ssxhash_eq, 1, 1, 0,
-       doc: /* Compute identity hash code for OBJ and return it as integer.
-In other words, hash codes of two non-`eq' lists will be (most likely)
-different, even if the lists contain the same elements. */)
+       doc: /* Return an integer hash code for OBJ suitable for `eq'.
+If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)).  */)
   (Lisp_Object obj)
 {
   return make_number (hashfn_eq (NULL, obj));
 }
 
 DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0,
-       doc: /* Compute identity hash code for OBJ and return it as integer.
-In comparison to `sxhash-eq', it is also guaranteed that hash codes
-of equal float numbers will be the same, even if the numbers are not
-the same Lisp object. */)
+       doc: /* Return an integer hash code for OBJ suitable for `eql'.
+If (eql A B), then (= (sxhash-eql A) (sxhash-eql B)).  */)
   (Lisp_Object obj)
 {
   return make_number (hashfn_eql (NULL, obj));
 }
 
 DEFUN ("sxhash-equal", Fsxhash_equal, Ssxhash_equal, 1, 1, 0,
-       doc: /* Compute a hash code for OBJ and return it as integer.  */)
+       doc: /* Return an integer hash code for OBJ suitable for `equal'.
+If (equal A B), then (= (sxhash-equal A) (sxhash-equal B)).  */)
   (Lisp_Object obj)
 {
-  EMACS_UINT hash = sxhash (obj, 0);
-  return make_number (hash);
+  return make_number (hashfn_equal (NULL, obj));
 }
 
-
 DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0,
        doc: /* Create and return a new hash table.
 
@@ -5202,6 +5227,7 @@ this variable.  */);
   defsubr (&Snconc);
   defsubr (&Smapcar);
   defsubr (&Smapc);
+  defsubr (&Smapcan);
   defsubr (&Smapconcat);
   defsubr (&Syes_or_no_p);
   defsubr (&Sload_average);
@@ -5220,22 +5246,4 @@ this variable.  */);
   defsubr (&Ssecure_hash);
   defsubr (&Sbuffer_hash);
   defsubr (&Slocale_info);
-
-  hashtest_eq.name = Qeq;
-  hashtest_eq.user_hash_function = Qnil;
-  hashtest_eq.user_cmp_function = Qnil;
-  hashtest_eq.cmpfn = 0;
-  hashtest_eq.hashfn = hashfn_eq;
-
-  hashtest_eql.name = Qeql;
-  hashtest_eql.user_hash_function = Qnil;
-  hashtest_eql.user_cmp_function = Qnil;
-  hashtest_eql.cmpfn = cmpfn_eql;
-  hashtest_eql.hashfn = hashfn_eql;
-
-  hashtest_equal.name = Qequal;
-  hashtest_equal.user_hash_function = Qnil;
-  hashtest_equal.user_cmp_function = Qnil;
-  hashtest_equal.cmpfn = cmpfn_equal;
-  hashtest_equal.hashfn = hashfn_equal;
 }