]> code.delx.au - gnu-emacs/blobdiff - src/fns.c
(try_window_id) <all changes below window end>: Don't
[gnu-emacs] / src / fns.c
index a317f1bef3ab46c73aed053f97814a735835a91d..2b398e08ce5ee3b6715e468ac56f6c711aaa61e1 100644 (file)
--- a/src/fns.c
+++ b/src/fns.c
@@ -1,5 +1,5 @@
 /* Random utility Lisp functions.
-   Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000
+   Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001
    Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -41,6 +41,7 @@ Boston, MA 02111-1307, USA.  */
 #include "intervals.h"
 #include "frame.h"
 #include "window.h"
+#include "blockinput.h"
 #if defined (HAVE_MENUS) && defined (HAVE_X_WINDOWS)
 #include "xterm.h"
 #endif
@@ -131,7 +132,7 @@ To get the number of bytes, use `string-bytes'")
   (sequence)
      register Lisp_Object sequence;
 {
-  register Lisp_Object tail, val;
+  register Lisp_Object val;
   register int i;
 
  retry:
@@ -326,9 +327,9 @@ If string STR1 is greater, the value is a positive number N;\n\
         past the character that we are comparing;
         hence we don't add or subtract 1 here.  */
       if (c1 < c2)
-       return make_number (- i1);
+       return make_number (- i1 + XINT (start1));
       else
-       return make_number (i1);
+       return make_number (i1 - XINT (start1));
     }
 
   if (i1 < end1_char)
@@ -830,6 +831,7 @@ concat (nargs, args, target_type, last_special)
   if (num_textprops > 0)
     {
       Lisp_Object props;
+      int last_to_end = -1;
 
       for (argnum = 0; argnum < num_textprops; argnum++)
        {
@@ -840,11 +842,11 @@ concat (nargs, args, target_type, last_special)
                                      Qnil);
          /* If successive arguments have properites, be sure that the
             value of `composition' property be the copy.  */
-         if (argnum > 0
-             && textprops[argnum - 1].argnum + 1 == textprops[argnum].argnum)
+         if (last_to_end == textprops[argnum].to)
            make_composition_value_copy (props);
          add_text_properties_from_list (val, props,
                                         make_number (textprops[argnum].to));
+         last_to_end = textprops[argnum].to + XSTRING (this)->size;
        }
     }
   return val;
@@ -1609,7 +1611,7 @@ to be sure of changing the value of `foo'.")
 {
   if (VECTORP (seq))
     {
-      EMACS_INT i, n, size;
+      EMACS_INT i, n;
 
       for (i = n = 0; i < ASIZE (seq); ++i)
        if (NILP (Fequal (AREF (seq, i), elt)))
@@ -1617,13 +1619,12 @@ to be sure of changing the value of `foo'.")
 
       if (n != ASIZE (seq))
        {
-         struct Lisp_Vector *p = allocate_vectorlike (n);
+         struct Lisp_Vector *p = allocate_vector (n);
 
          for (i = n = 0; i < ASIZE (seq); ++i)
            if (NILP (Fequal (AREF (seq, i), elt)))
              p->contents[n++] = AREF (seq, i);
 
-         p->size = n;
          XSETVECTOR (seq, p);
        }
     }
@@ -1852,8 +1853,8 @@ merge (org_l1, org_l2, pred)
       tail = tem;
     }
 }
-\f
 
+\f
 DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
   "Extract a value from a property list.\n\
 PLIST is a property list, which is a list of the form\n\
@@ -1862,16 +1863,26 @@ corresponding to the given PROP, or nil if PROP is not\n\
 one of the properties on the list.")
   (plist, prop)
      Lisp_Object plist;
-     register Lisp_Object prop;
+     Lisp_Object prop;
 {
-  register Lisp_Object tail;
-  for (tail = plist; !NILP (tail); tail = Fcdr (XCDR (tail)))
+  Lisp_Object tail;
+  
+  for (tail = plist;
+       CONSP (tail) && CONSP (XCDR (tail));
+       tail = XCDR (XCDR (tail)))
     {
-      register Lisp_Object tem;
-      tem = Fcar (tail);
-      if (EQ (prop, tem))
-       return Fcar (XCDR (tail));
+      if (EQ (prop, XCAR (tail)))
+       return XCAR (XCDR (tail));
+
+      /* This function can be called asynchronously
+        (setup_coding_system).  Don't QUIT in that case.  */
+      if (!interrupt_input_blocked)
+       QUIT;
     }
+
+  if (!NILP (tail))
+    wrong_type_argument (Qlistp, prop);
+  
   return Qnil;
 }
 
@@ -1909,7 +1920,9 @@ The PLIST is modified by side effects.")
          Fsetcar (XCDR (tail), val);
          return plist;
        }
+      
       prev = tail;
+      QUIT;
     }
   newcell = Fcons (prop, Fcons (val, Qnil));
   if (NILP (prev))
@@ -2351,10 +2364,11 @@ See also the documentation of make-char.")
        XCHAR_TABLE (char_table)->contents[charset + 128] = value;
       return value;
     }
-  char_table = temp;
-  if (! SUB_CHAR_TABLE_P (char_table))
+  if (SUB_CHAR_TABLE_P (temp))
+    char_table = temp;
+  else
     char_table = (XCHAR_TABLE (char_table)->contents[charset + 128]
-           = make_sub_char_table (temp));
+                 = make_sub_char_table (temp));
   temp = XCHAR_TABLE (char_table)->contents[code1];
   if (SUB_CHAR_TABLE_P (temp))
     XCHAR_TABLE (temp)->defalt = value;
@@ -2809,8 +2823,8 @@ is nil and `use-dialog-box' is non-nil.")
   GCPRO2 (prompt, xprompt);
 
 #ifdef HAVE_X_WINDOWS
-  if (display_busy_cursor_p)
-    cancel_busy_cursor ();
+  if (display_hourglass_p)
+    cancel_hourglass ();
 #endif
 
   while (1)
@@ -2822,7 +2836,7 @@ is nil and `use-dialog-box' is non-nil.")
          && have_menus_p ())
        {
          Lisp_Object pane, menu;
-         redisplay_preserve_echo_area ();
+         redisplay_preserve_echo_area (3);
          pane = Fcons (Fcons (build_string ("Yes"), Qt),
                        Fcons (Fcons (build_string ("No"), Qnil),
                               Qnil));
@@ -2942,7 +2956,7 @@ is nil, and `use-dialog-box' is non-nil.")
       && have_menus_p ())
     {
       Lisp_Object pane, menu, obj;
-      redisplay_preserve_echo_area ();
+      redisplay_preserve_echo_area (4);
       pane = Fcons (Fcons (build_string ("Yes"), Qt),
                    Fcons (Fcons (build_string ("No"), Qnil),
                           Qnil));
@@ -3050,12 +3064,14 @@ DEFUN ("require", Frequire, Srequire, 1, 3, 0,
 If FEATURE is not a member of the list `features', then the feature\n\
 is not loaded; so load the file FILENAME.\n\
 If FILENAME is omitted, the printname of FEATURE is used as the file name,\n\
-but in this case `load' insists on adding the suffix `.el' or `.elc'.\n\
+and `load' will try to load this name appended with the suffix `.elc',\n\
+`.el' or the unmodified name, in that order.\n\
 If the optional third argument NOERROR is non-nil,\n\
-then return nil if the file is not found.\n\
-Normally the return value is FEATURE.")
-  (feature, file_name, noerror)
-     Lisp_Object feature, file_name, noerror;
+then return nil if the file is not found instead of signaling an error.\n\
+Normally the return value is FEATURE.\n\
+The normal messages at start and end of loading FILENAME are suppressed.")
+  (feature, filename, noerror)
+     Lisp_Object feature, filename, noerror;
 {
   register Lisp_Object tem;
   CHECK_SYMBOL (feature, 0);
@@ -3071,8 +3087,8 @@ Normally the return value is FEATURE.")
       record_unwind_protect (un_autoload, Vautoload_queue);
       Vautoload_queue = Qt;
 
-      tem = Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name,
-                    noerror, Qt, Qnil, (NILP (file_name) ? Qt : Qnil));
+      tem = Fload (NILP (filename) ? Fsymbol_name (feature) : filename,
+                  noerror, Qt, Qnil, (NILP (filename) ? Qt : Qnil));
       /* If load failed entirely, return nil.  */
       if (NILP (tem))
        return unbind_to (count, Qnil);
@@ -3821,8 +3837,7 @@ larger_vector (vec, new_size, init)
   old_size = XVECTOR (vec)->size;
   xassert (new_size >= old_size);
 
-  v = allocate_vectorlike (new_size);
-  v->size = new_size;
+  v = allocate_vector (new_size);
   bcopy (XVECTOR (vec)->contents, v->contents,
         old_size * sizeof *v->contents);
   for (i = old_size; i < new_size; ++i)
@@ -3991,9 +4006,8 @@ make_hash_table (test, size, rehash_size, rehash_threshold, weak,
      Lisp_Object user_test, user_hash;
 {
   struct Lisp_Hash_Table *h;
-  struct Lisp_Vector *v;
   Lisp_Object table;
-  int index_size, i, len, sz;
+  int index_size, i, sz;
 
   /* Preconditions.  */
   xassert (SYMBOLP (test));
@@ -4007,16 +4021,11 @@ make_hash_table (test, size, rehash_size, rehash_threshold, weak,
   if (XFASTINT (size) == 0)
     size = make_number (1);
 
-  /* Allocate a vector, and initialize it.  */
-  len = VECSIZE (struct Lisp_Hash_Table);
-  v = allocate_vectorlike (len);
-  v->size = len;
-  for (i = 0; i < len; ++i)
-    v->contents[i] = Qnil;
+  /* Allocate a table and initialize it.  */
+  h = allocate_hash_table ();
 
   /* Initialize hash table slots.  */
   sz = XFASTINT (size);
-  h = (struct Lisp_Hash_Table *) v;
 
   h->test = test;
   if (EQ (test, Qeql))
@@ -4085,11 +4094,8 @@ copy_hash_table (h1)
   Lisp_Object table;
   struct Lisp_Hash_Table *h2;
   struct Lisp_Vector *v, *next;
-  int len;
 
-  len = VECSIZE (struct Lisp_Hash_Table);
-  v = allocate_vectorlike (len);
-  h2 = (struct Lisp_Hash_Table *) v;
+  h2 = allocate_hash_table ();
   next = h2->vec_next;
   bcopy (h1, h2, sizeof *h2);
   h2->vec_next = next;
@@ -4342,21 +4348,17 @@ sweep_weak_table (h, remove_entries_p)
 
   for (bucket = 0; bucket < n; ++bucket)
     {
-      Lisp_Object idx, prev;
+      Lisp_Object idx, next, prev;
 
       /* Follow collision chain, removing entries that
         don't survive this garbage collection.  */
-      idx = HASH_INDEX (h, bucket);
       prev = Qnil;
-      while (!GC_NILP (idx))
+      for (idx = HASH_INDEX (h, bucket); !GC_NILP (idx); idx = next)
        {
-         int remove_p;
          int i = XFASTINT (idx);
-         Lisp_Object next;
-         int key_known_to_survive_p, value_known_to_survive_p;
-
-         key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
-         value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
+         int key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
+         int value_known_to_survive_p = survives_gc_p (HASH_VALUE (h, i));
+         int remove_p;
 
          if (EQ (h->weak, Qkey))
            remove_p = !key_known_to_survive_p;
@@ -4377,7 +4379,7 @@ sweep_weak_table (h, remove_entries_p)
                {
                  /* Take out of collision chain.  */
                  if (GC_NILP (prev))
-                   HASH_INDEX (h, i) = next;
+                   HASH_INDEX (h, bucket) = next;
                  else
                    HASH_NEXT (h, XFASTINT (prev)) = next;
 
@@ -4410,8 +4412,6 @@ sweep_weak_table (h, remove_entries_p)
                    }
                }
            }
-
-         idx = next;
        }
     }
 
@@ -4974,17 +4974,30 @@ integers, including negative integers.")
 
 DEFUN ("md5", Fmd5, Smd5, 1, 5, 0,
   "Return MD5 message digest of OBJECT, a buffer or string.\n\
+A message digest is a cryptographic checksum of a document,\n\
+and the algorithm to calculate it is defined in RFC 1321.\n\
 \n\
 The two optional arguments START and END are character positions\n\
 specifying for which part of OBJECT the message digest should be computed.\n\
 If nil or omitted, the digest is computed for the whole OBJECT.\n\
 \n\
-Third optional argument CODING-SYSTEM specifies the coding system text\n\
-should be converted to before computing the digest.  If nil or omitted,\n\
-the current format is used or a format is guessed.\n\
+The MD5 message digest is computed from the result of encoding the\n\
+text in a coding system, not directly from the internal Emacs form\n\
+of the text.  The optional fourth argument CODING-SYSTEM specifies\n\
+which coding system to encode the text with.  It should be the same\n\
+coding system that you used or will use when actually writing the text\n\
+into a file.\n\
+\n\
+If CODING-SYSTEM is nil or omitted, the default depends on OBJECT.\n\
+If OBJECT is a buffer, the default for CODING-SYSTEM is whatever\n\
+coding system would be chosen by default for writing this text\n\
+into a file.\n\
+\n\
+If OBJECT is a string, the most preferred coding system (see the\n\
+command `prefer-coding-system') is used.\n\
 \n\
-Fourth optional argument NOERROR is there for compatability with other\n\
-Emacsen and is ignored.")
+If NOERROR is non-nil, silently assume the `raw_text' coding if the\n\
+guesswork fails.  Normally, an error is signaled in such case.")
   (object, start, end, coding_system, noerror)
      Lisp_Object object, start, end, coding_system, noerror;
 {