diff src/lread.c @ 83530:46b1096093f5

Merged from [e-mail]. Patches applied: * [e-mail]/emacs--devo--0--patch-294 Update from CVS * [e-mail]/emacs--devo--0--patch-295 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-296 Update from CVS: admin/FOR-RELEASE: Update refcard section. * [e-mail]/emacs--devo--0--patch-297 Update from CVS * [e-mail]/emacs--devo--0--patch-298 Update from CVS * [e-mail]/emacs--devo--0--patch-299 Update from CVS * [e-mail]/emacs--devo--0--patch-300 Update from CVS * [e-mail]/emacs--devo--0--patch-301 Update from CVS * [e-mail]/emacs--devo--0--patch-302 Update from CVS * [e-mail]/emacs--devo--0--patch-303 Update from CVS * [e-mail]/emacs--devo--0--patch-304 Update from CVS * [e-mail]/gnus--rel--5.10--patch-103 Update from CVS * [e-mail]/gnus--rel--5.10--patch-104 Update from CVS git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-570

--- a/src/lread.c	Fri May 26 17:37:25 2006 +0000
+++ b/src/lread.c	Mon Jun 12 07:27:12 2006 +0000
@@ -89,6 +89,7 @@
 Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
 Lisp_Object Qinhibit_file_name_operation;
 Lisp_Object Qeval_buffer_list, Veval_buffer_list;
+Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
 
 extern Lisp_Object Qevent_symbol_element_mask;
 extern Lisp_Object Qfile_exists_p;
@@ -720,8 +721,8 @@
   register int fd = -1;
   int count = SPECPDL_INDEX ();
   Lisp_Object temp;
-  struct gcpro gcpro1, gcpro2;
-  Lisp_Object found, efound;
+  struct gcpro gcpro1, gcpro2, gcpro3;
+  Lisp_Object found, efound, hist_file_name;
   /* 1 means we printed the ".el is newer" message.  */
   int newer = 0;
   /* 1 means we are loading a compiled file.  */
@@ -729,6 +730,7 @@
   Lisp_Object handler;
   int safe_p = 1;
   char *fmode = "r";
+  Lisp_Object tmp[2];
 #ifdef DOS_NT
   fmode = "rt";
 #endif /* DOS_NT */
@@ -745,7 +747,7 @@
      the need to gcpro noerror, nomessage and nosuffix.
      (Below here, we care only whether they are nil or not.)
      The presence of this call is the result of a historical accident:
-     it used to be in every file-operations and when it got removed
+     it used to be in every file-operation and when it got removed
      everywhere, it accidentally stayed here.  Since then, enough people
      supposedly have things like (load "$PROJECT/foo.el") in their .emacs
      that it seemed risky to remove.  */
@@ -765,7 +767,6 @@
   if (SCHARS (file) > 0)
     {
       int size = SBYTES (file);
-      Lisp_Object tmp[2];
 
       found = Qnil;
       GCPRO2 (file, found);
@@ -849,6 +850,13 @@
     Vloads_in_progress = Fcons (found, Vloads_in_progress);
   }
 
+  /* Get the name for load-history. */
+  hist_file_name = (! NILP (Vpurify_flag)
+                    ? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
+                                   tmp[1] = Ffile_name_nondirectory (found),
+                                   tmp))
+                    : found) ;
+
   if (!bcmp (SDATA (found) + SBYTES (found) - 4,
 	     ".elc", 4))
     /* Load .elc files directly, but not when they are
@@ -859,7 +867,7 @@
 	  struct stat s1, s2;
 	  int result;
 
-	  GCPRO2 (file, found);
+	  GCPRO3 (file, found, hist_file_name);
 
 	  if (!safe_to_load_p (fd))
 	    {
@@ -913,14 +921,14 @@
 
 	  if (fd >= 0)
 	    emacs_close (fd);
-	  val = call4 (Vload_source_file_function, found, file,
+	  val = call4 (Vload_source_file_function, found, hist_file_name,
 		       NILP (noerror) ? Qnil : Qt,
 		       NILP (nomessage) ? Qnil : Qt);
 	  return unbind_to (count, val);
 	}
     }
 
-  GCPRO2 (file, found);
+  GCPRO3 (file, found, hist_file_name);
 
 #ifdef WINDOWSNT
   emacs_close (fd);
@@ -959,14 +967,15 @@
   load_descriptor_list
     = Fcons (make_number (fileno (stream)), load_descriptor_list);
   load_in_progress++;
-  readevalloop (Qget_file_char, stream, (! NILP (Vpurify_flag) ? file : found),
+  readevalloop (Qget_file_char, stream, hist_file_name,
 		Feval, 0, Qnil, Qnil, Qnil, Qnil);
   unbind_to (count, Qnil);
 
-  /* Run any load-hooks for this file.  */
-  temp = Fassoc (file, Vafter_load_alist);
-  if (!NILP (temp))
-    Fprogn (Fcdr (temp));
+  /* Run any eval-after-load forms for this file */
+  if (NILP (Vpurify_flag)
+      && (!NILP (Ffboundp (Qdo_after_load_evaluation))))
+    call1 (Qdo_after_load_evaluation, hist_file_name) ;
+
   UNGCPRO;
 
   if (saved_doc_string)
@@ -1393,6 +1402,12 @@
 
   GCPRO4 (sourcename, readfun, start, end);
 
+  /* Try to ensure sourcename is a truename, except whilst preloading. */
+  if (NILP (Vpurify_flag)
+      && !NILP (sourcename) && Ffile_name_absolute_p (sourcename)
+      && (!NILP (Ffboundp (Qfile_truename))))
+    sourcename = call1 (Qfile_truename, sourcename) ;
+
   LOADHIST_ATTACH (sourcename);
 
   continue_reading_p = 1;
@@ -1751,6 +1766,9 @@
      int *byterep;
 {
   register int c = READCHAR;
+  /* \u allows up to four hex digits, \U up to eight. Default to the
+     behaviour for \u, and change this value in the case that \U is seen. */
+  int unicode_hex_count = 4;
 
   *byterep = 0;
 
@@ -1915,6 +1933,52 @@
 	return i;
       }
 
+    case 'U':
+      /* Post-Unicode-2.0: Up to eight hex chars.  */
+      unicode_hex_count = 8;
+    case 'u':
+
+      /* A Unicode escape. We only permit them in strings and characters,
+	 not arbitrarily in the source code, as in some other languages.  */
+      {
+	int i = 0;
+	int count = 0;
+	Lisp_Object lisp_char;
+	struct gcpro gcpro1;
+
+	while (++count <= unicode_hex_count)
+	  {
+	    c = READCHAR;
+	    /* isdigit(), isalpha() may be locale-specific, which we don't
+	       want. */
+	    if      (c >= '0' && c <= '9')  i = (i << 4) + (c - '0');
+	    else if (c >= 'a' && c <= 'f')  i = (i << 4) + (c - 'a') + 10;
+            else if (c >= 'A' && c <= 'F')  i = (i << 4) + (c - 'A') + 10;
+	    else
+	      {
+		error ("Non-hex digit used for Unicode escape");
+		break;
+	      }
+	  }
+
+	GCPRO1 (readcharfun);
+	lisp_char = call2(intern("decode-char"), intern("ucs"),
+			  make_number(i));
+	UNGCPRO;
+
+	if (EQ(Qnil, lisp_char))
+	  {
+	    /* This is ugly and horrible and trashes the user's data.  */
+	    XSETFASTINT (i, MAKE_CHAR (charset_katakana_jisx0201,
+				       34 + 128, 46 + 128));
+            return i;
+	  }
+	else
+	  {
+	    return XFASTINT (lisp_char);
+	  }
+      }
+
     default:
       if (BASE_LEADING_CODE_P (c))
 	c = read_multibyte (c, readcharfun);
@@ -3973,16 +4037,17 @@
 
   DEFVAR_LISP ("after-load-alist", &Vafter_load_alist,
 	       doc: /* An alist of expressions to be evalled when particular files are loaded.
-Each element looks like (FILENAME FORMS...).
-When `load' is run and the file-name argument is FILENAME,
-the FORMS in the corresponding element are executed at the end of loading.
-
-FILENAME must match exactly!  Normally FILENAME is the name of a library,
-with no directory specified, since that is how `load' is normally called.
-An error in FORMS does not undo the load,
-but does prevent execution of the rest of the FORMS.
-FILENAME can also be a symbol (a feature) and FORMS are then executed
-when the corresponding call to `provide' is made.  */);
+Each element looks like (REGEXP-OR-FEATURE FORMS...).
+
+REGEXP-OR-FEATURE is either a regular expression to match file names, or
+a symbol \(a feature name).
+
+When `load' is run and the file-name argument matches an element's
+REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
+REGEXP-OR-FEATURE, the FORMS in the element are executed.
+
+An error in FORMS does not undo the load, but does prevent execution of
+the rest of the FORMS.  */);
   Vafter_load_alist = Qnil;
 
   DEFVAR_LISP ("load-history", &Vload_history,
@@ -3990,6 +4055,10 @@
 Each alist element is a list that starts with a file name,
 except for one element (optional) that starts with nil and describes
 definitions evaluated from buffers not visiting files.
+
+The file name is absolute and is the true file name (i.e. it doesn't
+contain symbolic links) of the loaded file.
+
 The remaining elements of each list are symbols defined as variables
 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'.
@@ -4120,6 +4189,12 @@
   Qeval_buffer_list = intern ("eval-buffer-list");
   staticpro (&Qeval_buffer_list);
 
+  Qfile_truename = intern ("file-truename");
+  staticpro (&Qfile_truename) ;
+
+  Qdo_after_load_evaluation = intern ("do-after-load-evaluation");
+  staticpro (&Qdo_after_load_evaluation) ;
+
   staticpro (&dump_path);
 
   staticpro (&read_objects);