]> code.delx.au - gnu-emacs/blobdiff - src/editfns.c
* menu.c [HAVE_NTGUI]: Declare current_popup_menu.
[gnu-emacs] / src / editfns.c
index 0487ecf47074575091adc1c40763f9a230ee354f..8cf182dff0f6e29cdab3043ea129fcdc6426171b 100644 (file)
@@ -1,7 +1,7 @@
 /* Lisp functions pertaining to editing.
    Copyright (C) 1985, 1986, 1987, 1989, 1993, 1994, 1995, 1996,
                  1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-                 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+                 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -22,6 +22,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <config.h>
 #include <sys/types.h>
 #include <stdio.h>
+#include <setjmp.h>
 
 #ifdef HAVE_PWD_H
 #include <pwd.h>
@@ -67,6 +68,10 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #define NULL 0
 #endif
 
+#ifndef USER_FULL_NAME
+#define USER_FULL_NAME pw->pw_gecos
+#endif
+
 #ifndef USE_CRT_DLL
 extern char **environ;
 #endif
@@ -94,10 +99,11 @@ static Lisp_Object region_limit P_ ((int));
 int lisp_time_argument P_ ((Lisp_Object, time_t *, int *));
 static size_t emacs_memftimeu P_ ((char *, size_t, const char *,
                                   size_t, const struct tm *, int));
-static void general_insert_function P_ ((void (*) (const unsigned char *, int),
-                                        void (*) (Lisp_Object, int, int, int,
-                                                  int, int),
-                                        int, int, Lisp_Object *));
+static void general_insert_function (void (*) (const unsigned char *, EMACS_INT),
+                                    void (*) (Lisp_Object, EMACS_INT,
+                                              EMACS_INT, EMACS_INT,
+                                              EMACS_INT, int),
+                                    int, int, Lisp_Object *);
 static Lisp_Object subst_char_in_region_unwind P_ ((Lisp_Object));
 static Lisp_Object subst_char_in_region_unwind_1 P_ ((Lisp_Object));
 static void transpose_markers P_ ((int, int, int, int, int, int, int, int));
@@ -1274,12 +1280,13 @@ This is based on the effective uid, not the real uid.
 Also, if the environment variables LOGNAME or USER are set,
 that determines the value of this function.
 
-If optional argument UID is an integer, return the login name of the user
-with that uid, or nil if there is no such user.  */)
+If optional argument UID is an integer or a float, return the login name
+of the user with that uid, or nil if there is no such user.  */)
      (uid)
      Lisp_Object uid;
 {
   struct passwd *pw;
+  uid_t id;
 
   /* Set up the user name info if we didn't do it before.
      (That can happen if Emacs is dumpable
@@ -1290,9 +1297,9 @@ with that uid, or nil if there is no such user.  */)
   if (NILP (uid))
     return Vuser_login_name;
 
-  CHECK_NUMBER (uid);
+  id = (uid_t)XFLOATINT (uid);
   BLOCK_INPUT;
-  pw = (struct passwd *) getpwuid (XINT (uid));
+  pw = (struct passwd *) getpwuid (id);
   UNBLOCK_INPUT;
   return (pw ? build_string (pw->pw_name) : Qnil);
 }
@@ -1314,23 +1321,33 @@ This ignores the environment variables LOGNAME and USER, so it differs from
 
 DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0,
        doc: /* Return the effective uid of Emacs.
-Value is an integer or float, depending on the value.  */)
+Value is an integer or float, depending on the value.  */)
      ()
 {
   /* Assignment to EMACS_INT stops GCC whining about limited range of
      data type.  */
   EMACS_INT euid = geteuid ();
+
+  /* Make sure we don't produce a negative UID due to signed integer
+     overflow.  */
+  if (euid < 0)
+    return make_float ((double)geteuid ());
   return make_fixnum_or_float (euid);
 }
 
 DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0,
        doc: /* Return the real uid of Emacs.
-Value is an integer or float, depending on the value.  */)
+Value is an integer or float, depending on the value.  */)
      ()
 {
   /* Assignment to EMACS_INT stops GCC whining about limited range of
      data type.  */
   EMACS_INT uid = getuid ();
+
+  /* Make sure we don't produce a negative UID due to signed integer
+     overflow.  */
+  if (uid < 0)
+    return make_float ((double)getuid ());
   return make_fixnum_or_float (uid);
 }
 
@@ -1549,7 +1566,7 @@ DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0,
        doc: /* Return the current time, as a float number of seconds since the epoch.
 If SPECIFIED-TIME is given, it is the time to convert to float
 instead of the current time.  The argument should have the form
-(HIGH LOW . IGNORED). Thus, you can use times obtained from
+(HIGH LOW) or (HIGH LOW USEC). Thus, you can use times obtained from
 `current-time' and from `file-attributes'.  SPECIFIED-TIME can also
 have the form (HIGH . LOW), but this is considered obsolete.
 
@@ -2146,12 +2163,12 @@ set_time_zone_rule (tzstring)
    INSERT_FROM_STRING_FUNC as the last argument.  */
 
 static void
-general_insert_function (insert_func, insert_from_string_func,
-                        inherit, nargs, args)
-     void (*insert_func) P_ ((const unsigned char *, int));
-     void (*insert_from_string_func) P_ ((Lisp_Object, int, int, int, int, int));
-     int inherit, nargs;
-     register Lisp_Object *args;
+general_insert_function (void (*insert_func)
+                             (const unsigned char *, EMACS_INT),
+                        void (*insert_from_string_func)
+                             (Lisp_Object, EMACS_INT, EMACS_INT,
+                              EMACS_INT, EMACS_INT, int),
+                        int inherit, int nargs, Lisp_Object *args)
 {
   register int argnum;
   register Lisp_Object val;
@@ -2682,7 +2699,7 @@ determines whether case is significant or ignored.  */)
       else
        {
          c1 = BUF_FETCH_BYTE (bp1, i1);
-         c1 = unibyte_char_to_multibyte (c1);
+         MAKE_CHAR_MULTIBYTE (c1);
          i1++;
        }
 
@@ -2695,7 +2712,7 @@ determines whether case is significant or ignored.  */)
       else
        {
          c2 = BUF_FETCH_BYTE (bp2, i2);
-         c2 = unibyte_char_to_multibyte (c2);
+         MAKE_CHAR_MULTIBYTE (c2);
          i2++;
        }
 
@@ -3131,12 +3148,7 @@ It returns the number of characters changed.  */)
 
              if (VECTORP (val))
                {
-                 int i;
-
-                 string = Fmake_string (make_number (ASIZE (val)),
-                                        AREF (val, 0));
-                 for (i = 1; i < ASIZE (val); i++)
-                   Faset (string, make_number (i), AREF (val, i));
+                 string = Fconcat (1, &val);
                }
              else
                {
@@ -3263,12 +3275,26 @@ Lisp_Object
 save_restriction_restore (data)
      Lisp_Object data;
 {
+  struct buffer *cur = NULL;
+  struct buffer *buf = (CONSP (data)
+                       ? XMARKER (XCAR (data))->buffer
+                       : XBUFFER (data));
+
+  if (buf && buf != current_buffer && !NILP (buf->pt_marker))
+    { /* If `buf' uses markers to keep track of PT, BEGV, and ZV (as
+        is the case if it is or has an indirect buffer), then make
+        sure it is current before we update BEGV, so
+        set_buffer_internal takes care of managing those markers.  */
+      cur = current_buffer;
+      set_buffer_internal (buf);
+    }
+
   if (CONSP (data))
     /* A pair of marks bounding a saved restriction.  */
     {
       struct Lisp_Marker *beg = XMARKER (XCAR (data));
       struct Lisp_Marker *end = XMARKER (XCDR (data));
-      struct buffer *buf = beg->buffer; /* END should have the same buffer. */
+      eassert (buf == end->buffer);
 
       if (buf /* Verify marker still points to a buffer.  */
          && (beg->charpos != BUF_BEGV (buf) || end->charpos != BUF_ZV (buf)))
@@ -3293,8 +3319,6 @@ save_restriction_restore (data)
   else
     /* A buffer, which means that there was no old restriction.  */
     {
-      struct buffer *buf = XBUFFER (data);
-
       if (buf /* Verify marker still points to a buffer.  */
          && (BUF_BEGV (buf) != BUF_BEG (buf) || BUF_ZV (buf) != BUF_Z (buf)))
        /* The buffer has been narrowed, get rid of the narrowing.  */
@@ -3306,6 +3330,9 @@ save_restriction_restore (data)
        }
     }
 
+  if (cur)
+    set_buffer_internal (cur);
+
   return Qnil;
 }
 
@@ -4298,7 +4325,7 @@ transpose_markers (start1, end1, start2, end2,
 
 DEFUN ("transpose-regions", Ftranspose_regions, Stranspose_regions, 4, 5, 0,
        doc: /* Transpose region STARTR1 to ENDR1 with STARTR2 to ENDR2.
-The regions may not be overlapping, because the size of the buffer is
+The regions should not be overlapping, because the size of the buffer is
 never changed in a transposition.
 
 Optional fifth arg LEAVE-MARKERS, if non-nil, means don't update
@@ -4599,7 +4626,7 @@ syms_of_editfns ()
   initial_tz = 0;
 
   Qbuffer_access_fontify_functions
-    = intern ("buffer-access-fontify-functions");
+    = intern_c_string ("buffer-access-fontify-functions");
   staticpro (&Qbuffer_access_fontify_functions);
 
   DEFVAR_LISP ("inhibit-field-text-motion", &Vinhibit_field_text_motion,
@@ -4620,7 +4647,7 @@ of the buffer being accessed.  */);
     /* Do this here, because init_buffer_once is too early--it won't work.  */
     Fset_buffer (Vprin1_to_string_buffer);
     /* Make sure buffer-access-fontify-functions is nil in this buffer.  */
-    Fset (Fmake_local_variable (intern ("buffer-access-fontify-functions")),
+    Fset (Fmake_local_variable (intern_c_string ("buffer-access-fontify-functions")),
          Qnil);
     Fset_buffer (obuf);
   }
@@ -4663,9 +4690,9 @@ functions if all the text being accessed has this property.  */);
   defsubr (&Sregion_end);
 
   staticpro (&Qfield);
-  Qfield = intern ("field");
+  Qfield = intern_c_string ("field");
   staticpro (&Qboundary);
-  Qboundary = intern ("boundary");
+  Qboundary = intern_c_string ("boundary");
   defsubr (&Sfield_beginning);
   defsubr (&Sfield_end);
   defsubr (&Sfield_string);