]> code.delx.au - gnu-emacs/blobdiff - src/editfns.c
(w32_menu_display_help): Suppress tooltip when navigating menus with
[gnu-emacs] / src / editfns.c
index 9fbdc0363bba892be9b45f2c083c4a1e8d2e0205..05888fd48430290bf3adb900d898b4836c580d02 100644 (file)
@@ -1,6 +1,6 @@
 /* Lisp functions pertaining to editing.
-   Copyright (C) 1985,86,87,89,93,94,95,96,97,98,1999,2000,01,02,03,2004
-       Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1989, 1993, 1994, 1995, 1996, 1997, 1998,
+     1999, 2000, 2001, 2002, 2003, 2004, 2005  Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -16,16 +16,15 @@ GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA.  */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
 
 
 #include <config.h>
 #include <sys/types.h>
+#include <stdio.h>
 
-#ifdef VMS
-#include "vms-pwd.h"
-#else
+#ifdef HAVE_PWD_H
 #include <pwd.h>
 #endif
 
@@ -33,10 +32,17 @@ Boston, MA 02111-1307, USA.  */
 #include <unistd.h>
 #endif
 
-/* Without this, sprintf on Mac OS Classic will produce wrong
-   result.  */
-#ifdef MAC_OS8
-#include <stdio.h>
+#ifdef HAVE_SYS_UTSNAME_H
+#include <sys/utsname.h>
+#endif
+
+/* systime.h includes <sys/time.h> which, on some systems, is required
+   for <sys/resource.h>; thus systime.h must be included before
+   <sys/resource.h> */
+#include "systime.h"
+
+#if defined HAVE_SYS_RESOURCE_H
+#include <sys/resource.h>
 #endif
 
 #include <ctype.h>
@@ -49,8 +55,6 @@ Boston, MA 02111-1307, USA.  */
 #include "frame.h"
 #include "window.h"
 
-#include "systime.h"
-
 #ifdef STDC_HEADERS
 #include <float.h>
 #define MAX_10_EXP     DBL_MAX_10_EXP
@@ -104,6 +108,7 @@ Lisp_Object Vsystem_name;
 Lisp_Object Vuser_real_login_name;     /* login name of current user ID */
 Lisp_Object Vuser_full_name;           /* full name of current user */
 Lisp_Object Vuser_login_name;          /* user name from LOGNAME or USER */
+Lisp_Object Voperating_system_release;  /* Operating System Release */
 
 /* Symbol for the text property used to mark fields.  */
 
@@ -168,6 +173,16 @@ init_editfns ()
     Vuser_full_name = build_string (p);
   else if (NILP (Vuser_full_name))
     Vuser_full_name = build_string ("unknown");
+
+#ifdef HAVE_SYS_UTSNAME_H
+  {
+    struct utsname uts;
+    uname (&uts);
+    Voperating_system_release = build_string (uts.release);
+  }
+#else
+  Voperating_system_release = Qnil;
+#endif
 }
 \f
 DEFUN ("char-to-string", Fchar_to_string, Schar_to_string, 1, 1, 0,
@@ -248,10 +263,7 @@ clip_to_bounds (lower, num, upper)
 
 DEFUN ("goto-char", Fgoto_char, Sgoto_char, 1, 1, "NGoto char: ",
        doc: /* Set point to POSITION, a number or marker.
-Beginning of buffer is position (point-min), end is (point-max).
-If the position is in the middle of a multibyte form,
-the actual point is set at the head of the multibyte form
-except in the case that `enable-multibyte-characters' is nil.  */)
+Beginning of buffer is position (point-min), end is (point-max).  */)
      (position)
      register Lisp_Object position;
 {
@@ -1347,6 +1359,15 @@ get_system_name ()
     return "";
 }
 
+char *
+get_operating_system_release()
+{
+  if (STRINGP (Voperating_system_release))
+    return (char *) SDATA (Voperating_system_release);
+  else
+    return "";
+}
+
 DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0,
        doc: /* Return the process ID of Emacs, as an integer.  */)
      ()
@@ -1375,6 +1396,47 @@ resolution finer than a second.  */)
 
   return Flist (3, result);
 }
+
+DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time,
+       0, 0, 0,
+       doc: /* Return the current run time used by Emacs.
+The time is returned as a list of three integers.  The first has the
+most significant 16 bits of the seconds, while the second has the
+least significant 16 bits.  The third integer gives the microsecond
+count.
+
+On systems that can't determine the run time, get-internal-run-time
+does the same thing as current-time.  The microsecond count is zero on
+systems that do not provide resolution finer than a second.  */)
+     ()
+{
+#ifdef HAVE_GETRUSAGE
+  struct rusage usage;
+  Lisp_Object result[3];
+  int secs, usecs;
+
+  if (getrusage (RUSAGE_SELF, &usage) < 0)
+    /* This shouldn't happen.  What action is appropriate?  */
+    Fsignal (Qerror, Qnil);
+
+  /* Sum up user time and system time.  */
+  secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec;
+  usecs = usage.ru_utime.tv_usec + usage.ru_stime.tv_usec;
+  if (usecs >= 1000000)
+    {
+      usecs -= 1000000;
+      secs++;
+    }
+
+  XSETINT (result[0], (secs >> 16) & 0xffff);
+  XSETINT (result[1], (secs >> 0)  & 0xffff);
+  XSETINT (result[2], usecs);
+
+  return Flist (3, result);
+#else
+  return Fcurrent_time ();
+#endif
+}
 \f
 
 int
@@ -1431,10 +1493,10 @@ lisp_time_argument (specified_time, result, usec)
 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 forms:
- (HIGH . LOW) or (HIGH LOW USEC) or (HIGH LOW . USEC).
-Thus, you can use times obtained from `current-time'
-and from `file-attributes'.
+instead of the current time.  The argument should have the form
+(HIGH LOW . IGNORED). 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.
 
 WARNING: Since the result is floating point, it may not be exact.
 Do not use this function if precise time stamps are required.  */)
@@ -1506,8 +1568,9 @@ emacs_memftimeu (s, maxsize, format, format_len, tp, ut)
 
 DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0,
        doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted.
-TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as returned by
-`current-time' or `file-attributes'.
+TIME is specified as (HIGH LOW . IGNORED), as returned by
+`current-time' or `file-attributes'.  The obsolete form (HIGH . LOW)
+is also still accepted.
 The third, optional, argument UNIVERSAL, if non-nil, means describe TIME
 as Universal Time; nil means describe TIME in the local time zone.
 The value is a copy of FORMAT-STRING, but with certain constructs replaced
@@ -1603,17 +1666,19 @@ For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z".  */)
 
 DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 1, 0,
        doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE).
-The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED)
-or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil'
-to use the current time.  The list has the following nine members:
-SEC is an integer between 0 and 60; SEC is 60 for a leap second, which
-only some operating systems support.  MINUTE is an integer between 0 and 59.
-HOUR is an integer between 0 and 23.  DAY is an integer between 1 and 31.
-MONTH is an integer between 1 and 12.  YEAR is an integer indicating the
-four-digit year.  DOW is the day of week, an integer between 0 and 6, where
-0 is Sunday.  DST is t if daylight savings time is effect, otherwise nil.
-ZONE is an integer indicating the number of seconds east of Greenwich.
-(Note that Common Lisp has different meanings for DOW and ZONE.)  */)
+The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED),
+as from `current-time' and `file-attributes', or `nil' to use the
+current time.  The obsolete form (HIGH . LOW) is also still accepted.
+The list has the following nine members: SEC is an integer between 0
+and 60; SEC is 60 for a leap second, which only some operating systems
+support.  MINUTE is an integer between 0 and 59.  HOUR is an integer
+between 0 and 23.  DAY is an integer between 1 and 31.  MONTH is an
+integer between 1 and 12.  YEAR is an integer indicating the
+four-digit year.  DOW is the day of week, an integer between 0 and 6,
+where 0 is Sunday.  DST is t if daylight savings time is effect,
+otherwise nil.  ZONE is an integer indicating the number of seconds
+east of Greenwich.  (Note that Common Lisp has different meanings for
+DOW and ZONE.)  */)
      (specified_time)
      Lisp_Object specified_time;
 {
@@ -1745,13 +1810,11 @@ The format is `Sun Sep 16 01:03:52 1973'.
 However, see also the functions `decode-time' and `format-time-string'
 which provide a much more powerful and general facility.
 
-If SPECIFIED-TIME is given, it is a time to format instead
-of the current time.  The argument should have the form:
-  (HIGH . LOW)
-or the form:
-  (HIGH LOW . IGNORED).
-Thus, you can use times obtained from `current-time'
-and from `file-attributes'.  */)
+If SPECIFIED-TIME is given, it is a time to format instead of the
+current time.  The argument should have the form (HIGH LOW . IGNORED).
+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.  */)
      (specified_time)
      Lisp_Object specified_time;
 {
@@ -1802,12 +1865,10 @@ OFFSET is an integer number of seconds ahead of UTC (east of Greenwich).
     A negative value means west of Greenwich.
 NAME is a string giving the name of the time zone.
 If SPECIFIED-TIME is given, the time zone offset is determined from it
-instead of using the current time.  The argument should have the form:
-  (HIGH . LOW)
-or the form:
-  (HIGH LOW . IGNORED).
-Thus, you can use times obtained from `current-time'
-and from `file-attributes'.
+instead of using the current time.  The argument should have the form
+(HIGH LOW . IGNORED).  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.
 
 Some operating systems cannot provide all this information to Emacs;
 in this case, `current-time-zone' returns a list containing nil for
@@ -2599,7 +2660,7 @@ Both characters must have the same length of multi-byte form.  */)
     {
       len = CHAR_STRING (XFASTINT (fromchar), fromstr);
       if (CHAR_STRING (XFASTINT (tochar), tostr) != len)
-       error ("Characters in subst-char-in-region have different byte-lengths");
+       error ("Characters in `subst-char-in-region' have different byte-lengths");
       if (!ASCII_BYTE_P (*tostr))
        {
          /* If *TOSTR is in the range 0x80..0x9F and TOCHAR is not a
@@ -2737,8 +2798,10 @@ Both characters must have the same length of multi-byte form.  */)
   return Qnil;
 }
 
-DEFUN ("translate-region", Ftranslate_region, Stranslate_region, 3, 3, 0,
-       doc: /* From START to END, translate characters according to TABLE.
+DEFUN ("translate-region-internal", Ftranslate_region_internal,
+       Stranslate_region_internal, 3, 3, 0,
+       doc: /* Internal use only.
+From START to END, translate characters according to TABLE.
 TABLE is a string; the Nth character in it is the mapping
 for the character with code N.
 It returns the number of characters changed.  */)
@@ -2751,31 +2814,37 @@ It returns the number of characters changed.  */)
   register int nc;             /* New character. */
   int cnt;                     /* Number of changes made. */
   int size;                    /* Size of translate table. */
-  int pos, pos_byte;
+  int pos, pos_byte, end_pos;
   int multibyte = !NILP (current_buffer->enable_multibyte_characters);
   int string_multibyte;
 
   validate_region (&start, &end);
-  CHECK_STRING (table);
-
-  if (multibyte != (SCHARS (table) < SBYTES (table)))
-    table = (multibyte
-            ? string_make_multibyte (table)
-            : string_make_unibyte (table));
-  string_multibyte = SCHARS (table) < SBYTES (table);
+  if (CHAR_TABLE_P (table))
+    {
+      size = MAX_CHAR;
+      tt = NULL;
+    }
+  else
+    {
+      CHECK_STRING (table);
 
-  size = SCHARS (table);
-  tt = SDATA (table);
+      if (! multibyte && (SCHARS (table) < SBYTES (table)))
+       table = string_make_unibyte (table);
+      string_multibyte = SCHARS (table) < SBYTES (table);
+      size = SCHARS (table);
+      tt = SDATA (table);
+    }
 
   pos = XINT (start);
   pos_byte = CHAR_TO_BYTE (pos);
+  end_pos = XINT (end);
   modify_region (current_buffer, pos, XINT (end));
 
   cnt = 0;
-  for (; pos < XINT (end); )
+  for (; pos < end_pos; )
     {
       register unsigned char *p = BYTE_POS_ADDR (pos_byte);
-      unsigned char *str;
+      unsigned char *str, buf[MAX_MULTIBYTE_LENGTH];
       int len, str_len;
       int oc;
 
@@ -2785,16 +2854,45 @@ It returns the number of characters changed.  */)
        oc = *p, len = 1;
       if (oc < size)
        {
-         if (string_multibyte)
+         if (tt)
            {
-             str = tt + string_char_to_byte (table, oc);
-             nc = STRING_CHAR_AND_LENGTH (str, MAX_MULTIBYTE_LENGTH, str_len);
+             if (string_multibyte)
+               {
+                 str = tt + string_char_to_byte (table, oc);
+                 nc = STRING_CHAR_AND_LENGTH (str, MAX_MULTIBYTE_LENGTH,
+                                              str_len);
+               }
+             else
+               {
+                 nc = tt[oc];
+                 if (! ASCII_BYTE_P (nc) && multibyte)
+                   {
+                     str_len = CHAR_STRING (nc, buf);
+                     str = buf;
+                   }
+                 else
+                   {
+                     str_len = 1;
+                     str = tt + oc;
+                   }
+               }
            }
          else
            {
-             str = tt + oc;
-             nc = tt[oc], str_len = 1;
+             Lisp_Object val;
+             int c;
+
+             nc = oc;
+             val = CHAR_TABLE_REF (table, oc);
+             if (INTEGERP (val)
+                 && (c = XINT (val), CHAR_VALID_P (c, 0)))
+               {
+                 nc = c;
+                 str_len = CHAR_STRING (nc, buf);
+                 str = buf;
+               }
            }
+
          if (nc != oc)
            {
              if (len != str_len)
@@ -2845,6 +2943,8 @@ DEFUN ("delete-and-extract-region", Fdelete_and_extract_region,
      Lisp_Object start, end;
 {
   validate_region (&start, &end);
+  if (XINT (start) == XINT (end))
+    return build_string ("");
   return del_range_1 (XINT (start), XINT (end), 1, 1);
 }
 \f
@@ -3011,11 +3111,14 @@ static int message_length;
 
 DEFUN ("message", Fmessage, Smessage, 1, MANY, 0,
        doc: /* Print a one-line message at the bottom of the screen.
+The message also goes into the `*Messages*' buffer.
+\(In keyboard macros, that's all it does.)
+
 The first argument is a format control string, and the rest are data
 to be formatted under control of the string.  See `format' for details.
 
-If the first argument is nil, clear any existing message; let the
-minibuffer contents show.
+If the first argument is nil, the function clears any existing message;
+this lets the minibuffer contents show.  See also `current-message'.
 
 usage: (message STRING &rest ARGS)  */)
      (nargs, args)
@@ -3027,7 +3130,7 @@ usage: (message STRING &rest ARGS)  */)
          && SBYTES (args[0]) == 0))
     {
       message (0);
-      return Qnil;
+      return args[0];
     }
   else
     {
@@ -3072,7 +3175,7 @@ usage: (message-box STRING &rest ARGS)  */)
        pane = Fcons (Fcons (build_string ("OK"), Qt), Qnil);
        GCPRO1 (pane);
        menu = Fcons (val, pane);
-       obj = Fx_popup_dialog (Qt, menu);
+       obj = Fx_popup_dialog (Qt, menu, Qt);
        UNGCPRO;
        return val;
       }
@@ -3230,7 +3333,7 @@ usage: (format STRING &rest OBJECTS)  */)
   /* discarded[I] is 1 if byte I of the format
      string was not copied into the output.
      It is 2 if byte I was not the first byte of its character.  */
-  char *discarded;
+  char *discarded = 0;
 
   /* Each element records, for one argument,
      the start and end bytepos in the output string,
@@ -3255,6 +3358,7 @@ usage: (format STRING &rest OBJECTS)  */)
       /* Piggyback on this loop to initialize precision[N]. */
       precision[n] = -1;
     }
+  precision[nargs] = -1;
 
   CHECK_STRING (args[0]);
   /* We may have to change "%S" to "%s". */
@@ -3278,13 +3382,15 @@ usage: (format STRING &rest OBJECTS)  */)
 
   /* Allocate the info and discarded tables.  */
   {
-    int nbytes = nargs * sizeof *info;
+    int nbytes = (nargs+1) * sizeof *info;
     int i;
-    info = (struct info *) alloca (nbytes);
+    if (!info)
+      info = (struct info *) alloca (nbytes);
     bzero (info, nbytes);
-    for (i = 0; i < nargs; i++)
+    for (i = 0; i <= nargs; i++)
       info[i].start = -1;
-    discarded = (char *) alloca (SBYTES (args[0]));
+    if (!discarded)
+      SAFE_ALLOCA (discarded, char *, SBYTES (args[0]));
     bzero (discarded, SBYTES (args[0]));
   }
 
@@ -3645,7 +3751,7 @@ usage: (format STRING &rest OBJECTS)  */)
   val = make_specified_string (buf, nchars, p - buf, multibyte);
 
   /* If we allocated BUF with malloc, free it too.  */
-  SAFE_FREE (total);
+  SAFE_FREE ();
 
   /* If the format string has text properties, or any of the string
      arguments has text properties, set up text properties of the
@@ -3668,11 +3774,13 @@ usage: (format STRING &rest OBJECTS)  */)
 
          /* Adjust the bounds of each text property
             to the proper start and end in the output string.  */
-         /* We take advantage of the fact that the positions in PROPS
-            are in increasing order, so that we can do (effectively)
-            one scan through the position space of the format string.
 
-            BYTEPOS is the byte position in the format string,
+         /* Put the positions in PROPS in increasing order, so that
+            we can do (effectively) one scan through the position
+            space of the format string.  */
+         props = Fnreverse (props);
+
+         /* BYTEPOS is the byte position in the format string,
             POSITION is the untranslated char position in it,
             TRANSLATED is the translated char position in BUF,
             and ARGN is the number of the next arg we will come to.  */
@@ -4015,7 +4123,7 @@ Transposing beyond buffer boundaries is an error.  */)
           bcopy (start2_addr, temp, len2_byte);
           bcopy (start1_addr, start1_addr + len2_byte, len1_byte);
           bcopy (temp, start1_addr, len2_byte);
-         SAFE_FREE (len2_byte);
+         SAFE_FREE ();
         }
       else
        /* First region not smaller than second.  */
@@ -4028,7 +4136,7 @@ Transposing beyond buffer boundaries is an error.  */)
           bcopy (start1_addr, temp, len1_byte);
           bcopy (start2_addr, start1_addr, len2_byte);
           bcopy (temp, start1_addr + len2_byte, len1_byte);
-         SAFE_FREE (len1_byte);
+         SAFE_FREE ();
         }
       graft_intervals_into_buffer (tmp_interval1, start1 + len2,
                                    len1, current_buffer, 0);
@@ -4064,7 +4172,7 @@ Transposing beyond buffer boundaries is an error.  */)
           bcopy (start1_addr, temp, len1_byte);
           bcopy (start2_addr, start1_addr, len2_byte);
           bcopy (temp, start2_addr, len1_byte);
-         SAFE_FREE (len1_byte);
+         SAFE_FREE ();
 
           graft_intervals_into_buffer (tmp_interval1, start2,
                                        len1, current_buffer, 0);
@@ -4093,7 +4201,7 @@ Transposing beyond buffer boundaries is an error.  */)
           bcopy (start1_addr, start1_addr + len_mid + len2_byte, len1_byte);
           safe_bcopy (start1_addr + len1_byte, start1_addr + len2_byte, len_mid);
           bcopy (temp, start1_addr, len2_byte);
-         SAFE_FREE (len2_byte);
+         SAFE_FREE ();
 
           graft_intervals_into_buffer (tmp_interval1, end2 - len1,
                                        len1, current_buffer, 0);
@@ -4124,7 +4232,7 @@ Transposing beyond buffer boundaries is an error.  */)
           bcopy (start2_addr, start1_addr, len2_byte);
           bcopy (start1_addr + len1_byte, start1_addr + len2_byte, len_mid);
           bcopy (temp, start1_addr + len2_byte + len_mid, len1_byte);
-         SAFE_FREE (len1_byte);
+         SAFE_FREE ();
 
           graft_intervals_into_buffer (tmp_interval1, end2 - len1,
                                        len1, current_buffer, 0);
@@ -4204,6 +4312,9 @@ functions if all the text being accessed has this property.  */);
   DEFVAR_LISP ("user-real-login-name", &Vuser_real_login_name,
               doc: /* The user's name, based upon the real uid only.  */);
 
+  DEFVAR_LISP ("operating-system-release", &Voperating_system_release,
+              doc: /* The release of the operating system Emacs is running on.  */);
+
   defsubr (&Spropertize);
   defsubr (&Schar_equal);
   defsubr (&Sgoto_char);
@@ -4269,6 +4380,7 @@ functions if all the text being accessed has this property.  */);
   defsubr (&Suser_full_name);
   defsubr (&Semacs_pid);
   defsubr (&Scurrent_time);
+  defsubr (&Sget_internal_run_time);
   defsubr (&Sformat_time_string);
   defsubr (&Sfloat_time);
   defsubr (&Sdecode_time);
@@ -4286,7 +4398,7 @@ functions if all the text being accessed has this property.  */);
   defsubr (&Sinsert_buffer_substring);
   defsubr (&Scompare_buffer_substrings);
   defsubr (&Ssubst_char_in_region);
-  defsubr (&Stranslate_region);
+  defsubr (&Stranslate_region_internal);
   defsubr (&Sdelete_region);
   defsubr (&Sdelete_and_extract_region);
   defsubr (&Swiden);