Mercurial > hg > xemacs-beta

changeset 3368:959746c534f6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2006-04-29 16:15:21 by aidan] Support builtin functions in find-function.
author aidan
date Sat, 29 Apr 2006 16:15:31 +0000
parents 84ee3ca77e7f
children 2c5142751000
files lib-src/ChangeLog lib-src/make-docfile.c lisp/ChangeLog lisp/dumped-lisp.el lisp/help.el lisp/loadhist.el src/ChangeLog src/doc.c src/symbols.c src/sysfile.h
diffstat 10 files changed, 432 insertions(+), 33 deletions(-) [+]
line wrap: on
line diff
--- a/lib-src/ChangeLog	Sat Apr 29 14:36:57 2006 +0000
+++ b/lib-src/ChangeLog	Sat Apr 29 16:15:31 2006 +0000
@@ -1,3 +1,12 @@
+2006-04-29  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* make-docfile.c:
+	* make-docfile.c (put_filename):
+	* make-docfile.c (scan_c_file):
+	* make-docfile.c (scan_lisp_file):
+	Record file name information for built-in symbols. Based on the
+	FSF's implementation of same. 
+	
 2006-03-31  Stephen J. Turnbull  <stephen@xemacs.org>
 
 	* XEmacs 21.5.26 "endive" is released.
--- a/lib-src/make-docfile.c	Sat Apr 29 14:36:57 2006 +0000
+++ b/lib-src/make-docfile.c	Sat Apr 29 16:15:31 2006 +0000
@@ -44,6 +44,7 @@
 #include <config.h>
 #include <sysfile.h>
 
+#include <assert.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
@@ -58,6 +59,7 @@
   ('0' <= c && c <= '9') ||			\
   (c == '_'))
 
+static void put_filename (const char *filename);
 static int scan_file (const char *filename);
 static int read_c_string (FILE *, int, int);
 static void write_c_args (FILE *out, const char *func, char *buf, int minargs,
@@ -263,6 +265,30 @@
   return err_count > 0;
 }
 
+/* Add a source file name boundary in the output file.  */
+static void
+put_filename (const char *filename)
+{
+  const char *tmp;
+
+  /* Why are we cutting this off? */
+  for (tmp = filename; *tmp; tmp++)
+    {
+      if (IS_DIRECTORY_SEP(*tmp))
+	filename = tmp + 1;
+    }
+
+  /* <= because sizeof includes the nul byte at the end. Not quite right,
+     because it should include the length of the symbol + "\037[VF]" instead
+     of simply 10. */
+  assert(sizeof("\037S\n") + strlen(filename) + 10 
+	 <= DOC_MAX_FILENAME_LENGTH);
+
+  putc (037, outfile);
+  putc ('S', outfile);
+  fprintf (outfile, "%s\n", filename);
+}
+
 /* Read file FILENAME and output its doc strings to outfile.  */
 /* Return 1 if file is not found, 0 if it is found.  */
 
@@ -864,11 +890,14 @@
       if (defunflag || defvarflag || c == '"')
 	{
 	  /* XEmacs change: the original code is in the "else" clause */
+	  /* XXX Must modify the documentation file name code to handle
+	     ELLCCs */
 	  if (ellcc)
 	    fprintf (outfile, "  CDOC%s(\"%s\", \"\\\n",
 		     defvarflag ? "SYM" : "SUBR", globalbuf);
 	  else
 	    {
+	      put_filename (filename);	/* XEmacs addition */
 	      putc (037, outfile);
 	      putc (defvarflag ? 'V' : 'F', outfile);
 	      fprintf (outfile, "%s\n", globalbuf);
@@ -963,6 +992,10 @@
  The NAME and DOCSTRING are output.
  NAME is preceded by `F' for a function or `V' for a variable.
  An entry is output only if DOCSTRING has \ newline just after the opening "
+
+ Adds the filename a symbol or function was found in before its docstring;
+ there's no need for this with the load-history available, but we do it for
+ consistency with the C parsing code. 
  */
 
 static void
@@ -1356,6 +1389,7 @@
 	 In the latter case, the opening quote (and leading
 	 backslash-newline) have already been read.  */
 
+      put_filename (filename);	/* XEmacs addition */
       putc ('\n', outfile);	/* XEmacs addition */
       putc (037, outfile);
       putc (type, outfile);
--- a/lisp/ChangeLog	Sat Apr 29 14:36:57 2006 +0000
+++ b/lisp/ChangeLog	Sat Apr 29 16:15:31 2006 +0000
@@ -1,3 +1,22 @@
+2006-04-29  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* dumped-lisp.el (preloaded-file-list):
+	Move loadhist earlier in the preloaded-file list. 
+	* help.el:
+	* help.el (help-mode-map): Add bindings to find the source code of
+	a function, notably when that function's in C. 
+	* help.el (describe-function-find-file, describe-symbol-find-file):
+	Removed. Use symbol-file from loadhist.el instead. 
+	* help.el (frob-help-extents):
+	* help.el (describe-function-1):
+	Allow built-in function file names to be hyperlinks. 
+	* help.el (describe-variable):
+	* help.el (help-find-source-or-scroll-up): New.
+	* help.el (help-mouse-find-source-or-track): New.
+	Make describe-function a bit more mouse-friendly, basically. 
+	* loadhist.el (symbol-file):
+	Support looking up builtin symbols using built-in-symbol-file. 
+	
 2006-04-23  Ville Skyttä  <scop@xemacs.org>
 
 	* simple.el (goto-line): Add optional `buffer' argument, from
--- a/lisp/dumped-lisp.el	Sat Apr 29 14:36:57 2006 +0000
+++ b/lisp/dumped-lisp.el	Sat Apr 29 16:15:31 2006 +0000
@@ -92,6 +92,8 @@
 				;  `emacs-user-extension-dir'
        "misc"
        ;; (pureload "profile")
+       "loadhist"		; Must be dumped before loaddefs is loaded
+				; Used by help. 
        "help"
        ;; (pureload "hyper-apropos")  Soon...
        "files"
@@ -308,7 +310,6 @@
         ;;     "sun-eos-debugger"
         ;;     "sun-eos-debugger-extra"
         ;;     "sun-eos-menubar"))
-       "loadhist"		; Must be dumped before loaddefs is loaded
        "loaddefs"		; <=== autoloads get loaded here
 	))
 
--- a/lisp/help.el	Sat Apr 29 14:36:57 2006 +0000
+++ b/lisp/help.el	Sat Apr 29 16:15:31 2006 +0000
@@ -1,4 +1,4 @@
-;;; help.el --- help commands for XEmacs.
+;; help.el --- help commands for XEmacs.
 
 ;; Copyright (C) 1985, 1986, 1992-4, 1997 Free Software Foundation, Inc.
 ;; Copyright (C) 2001, 2002, 2003 Ben Wing.
@@ -41,6 +41,8 @@
 ;; or run interpreted, but not when the compiled code is loaded.
 (eval-when-compile (require 'help-macro))
 
+(require 'loadhist) ;; For symbol-file. 
+
 (defgroup help nil
   "Support for on-line help systems."
   :group 'emacs)
@@ -153,6 +155,8 @@
 (define-key help-mode-map "c" 'customize-variable)
 (define-key help-mode-map [tab] 'help-next-symbol)
 (define-key help-mode-map [(shift tab)] 'help-prev-symbol)
+(define-key help-mode-map [return] 'help-find-source-or-scroll-up)
+(define-key help-mode-map [button2] 'help-mouse-find-source-or-track)
 (define-key help-mode-map "n" 'help-next-section)
 (define-key help-mode-map "p" 'help-prev-section)
 
@@ -1091,14 +1095,14 @@
   :type 'boolean
   :group 'help-appearance)
 
-(defun describe-symbol-find-file (symbol)
-  (loop for (file . load-data) in load-history
-    do (when (memq symbol load-data)
-	 (return file))))
+(define-obsolete-function-alias
+  ;; Moved to using the version in loadhist.el
+  'describe-function-find-symbol
+  'symbol-file)
 
 (define-obsolete-function-alias
   'describe-function-find-file
-  'describe-symbol-find-file)
+  'symbol-file)
 
 (defun describe-function (function)
   "Display the full documentation of FUNCTION (a symbol).
@@ -1340,6 +1344,7 @@
 	  (when (or var fun)
 	    (let ((ex (make-extent b e)))
 	      (require 'hyper-apropos)
+
 	      (set-extent-property ex 'mouse-face 'highlight)
 	      (set-extent-property ex 'help-symbol sym)
 	      (set-extent-property ex 'face 'hyper-apropos-hyperlink)
@@ -1421,10 +1426,21 @@
     (if autoload-file
 	(princ (format "  -- autoloads from \"%s\"\n" autoload-file)))
     (or file-name
-	(setq file-name (describe-symbol-find-file function)))
-    (if file-name
-	(princ (format "  -- loaded from \"%s\"\n" file-name)))
-;;     (terpri)
+	(setq file-name (symbol-file function)))
+    (when file-name
+	(princ "  -- loaded from \"")
+	(if (not (bufferp standard-output))
+	    (princ file-name)
+	  (let ((opoint (point standard-output))
+		e)
+	    (require 'hyper-apropos)
+	    (princ file-name)
+	    (setq e (make-extent opoint (point standard-output)
+				 standard-output))
+	    (set-extent-property e 'face 'hyper-apropos-hyperlink)
+	    (set-extent-property e 'mouse-face 'highlight)
+	    (set-extent-property e 'find-function-symbol function)))
+	(princ "\"\n"))
     (if describe-function-show-arglist
 	(let ((arglist (function-arglist function)))
 	  (when arglist
@@ -1469,7 +1485,6 @@
 			     (eq ?\n (aref doc (1- (length doc)))))
 		   (terpri)))))))))
 
-
 ;;; [Obnoxious, whining people who complain very LOUDLY on Usenet
 ;;; are binding this to keys.]
 (defun describe-function-arglist (function)
@@ -1590,11 +1605,22 @@
 	     (princ (format "%s" aliases)))
 	 (princ (built-in-variable-doc variable))
 	 (princ ".\n")
-	 (let ((file-name (describe-symbol-find-file variable)))
-	   (if file-name
-	       (princ (format "  -- loaded from \"%s\"\n" file-name))))
+	 (require 'hyper-apropos)
+	 (let ((file-name (symbol-file variable))
+	       opoint e)
+	   (when file-name
+	       (princ "  -- loaded from \"")
+	       (if (not (bufferp standard-output))
+		   (princ file-name)
+		 (setq opoint (point standard-output))
+		 (princ file-name)
+		 (setq e (make-extent opoint (point standard-output)
+				      standard-output))
+		 (set-extent-property e 'face 'hyper-apropos-hyperlink)
+		 (set-extent-property e 'mouse-face 'highlight)
+		 (set-extent-property e 'find-variable-symbol variable))
+	       (princ"\"\n")))
 	 (princ "\nValue: ")
-	 (require 'hyper-apropos)
     	 (if (not (boundp variable))
 	     (Help-princ-face "void\n" 'hyper-apropos-documentation)
 	   (Help-prin1-face (symbol-value variable)
@@ -1779,4 +1805,28 @@
 	(with-displaying-help-buffer
 	 (insert string)))))
 
+(defun help-find-source-or-scroll-up (&optional pos)
+  "Follow any cross reference to source code; if none, scroll up.  "
+  (interactive "d")
+  (let ((e (extent-at pos nil 'find-function-symbol)))
+    (if e
+	(find-function (extent-property e 'find-function-symbol))
+      (setq e (extent-at pos nil 'find-variable-symbol))
+      (if e 
+	  (find-variable (extent-property e 'find-variable-symbol))
+	(view-scroll-lines-up 1)))))
+
+(defun help-mouse-find-source-or-track (event)
+  "Follow any cross reference to source code under the mouse; 
+if none, call mouse-track.  "
+  (interactive "e")
+  (mouse-set-point event)
+  (let ((e (extent-at (point) nil 'find-function-symbol)))
+    (if e
+	(find-function (extent-property e 'find-function-symbol))
+      (setq e (extent-at (point) nil 'find-variable-symbol))
+      (if e 
+	  (find-variable (extent-property e 'find-variable-symbol))
+	(mouse-track event)))))
+
 ;;; help.el ends here
--- a/lisp/loadhist.el	Sat Apr 29 14:36:57 2006 +0000
+++ b/lisp/loadhist.el	Sat Apr 29 16:15:31 2006 +0000
@@ -41,9 +41,15 @@
   "Return the input source from which SYM was loaded.
 This is a file name, or nil if the source was a buffer with no associated file."
   (interactive "SFind source file for symbol: ") ; XEmacs
-  (dolist (entry load-history)
-    (when (memq sym (cdr entry))
-      (return (car entry)))))
+  (block look-up-symbol-file
+    (dolist (entry load-history)
+      (when (memq sym (cdr entry))
+	(return-from look-up-symbol-file (car entry))))
+    (when (or (and (boundp sym) (built-in-variable-type sym))
+	      (and (fboundp sym) (subrp (symbol-function sym))))
+      (let ((built-in-file (built-in-symbol-file sym)))
+	(if built-in-file
+	    (concat build-root "/src/" built-in-file))))))
 
 (defun feature-symbols (feature)
   "Return the file and list of symbols associated with a given FEATURE."
--- a/src/ChangeLog	Sat Apr 29 14:36:57 2006 +0000
+++ b/src/ChangeLog	Sat Apr 29 16:15:31 2006 +0000
@@ -1,3 +1,12 @@
+2006-04-29  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* doc.c:
+	* doc.c (extract_object_file_name):
+	* doc.c (get_object_file_name):
+	* doc.c (Fbuilt_in_symbol_file):
+	Support saving and recovering the source file name of a built-in
+	symbol (that is, one created in C.) 
+	
 2006-04-29  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* lread.c:
--- a/src/doc.c	Sat Apr 29 14:36:57 2006 +0000
+++ b/src/doc.c	Sat Apr 29 16:15:31 2006 +0000
@@ -39,10 +39,127 @@
 
 Lisp_Object QSsubstitute;
 
-/* Read and return doc string or instructions from open file descriptor FD
-   at position POSITION.  Does not close the file.  Returns string; or if
-   error, returns a cons holding the error data to pass to Fsignal.
-   NAME_NONRELOC and NAME_RELOC are only used for the error messages. */
+/* Work out what source file a function or variable came from, taking the
+   information from the documentation file. */
+
+static Lisp_Object
+extract_object_file_name (int fd, EMACS_INT doc_pos,
+			  Ibyte *name_nonreloc, Lisp_Object name_reloc,
+			  int standard_doc_file)
+{
+  Ibyte buf[DOC_MAX_FILENAME_LENGTH];
+  Ibyte *buffer = buf;
+  int buffer_size = sizeof (buf), space_left;
+  Ibyte *from, *to;
+  REGISTER Ibyte *p = buffer;
+  Lisp_Object return_me;
+  Lisp_Object fdstream = Qnil, instream = Qnil;
+  struct gcpro gcpro1, gcpro2;
+  EMACS_INT position, seenS = 0;
+
+  GCPRO2 (fdstream, instream);
+
+  position = doc_pos > DOC_MAX_FILENAME_LENGTH  ? 
+    doc_pos - DOC_MAX_FILENAME_LENGTH : 0; 
+
+  if (0 > lseek (fd, position, 0))
+    {
+      if (name_nonreloc)
+	name_reloc = build_intstring (name_nonreloc);
+      return_me = list3 (build_msg_string
+			 ("Position out of range in doc string file"),
+			  name_reloc, make_int (position));
+      goto done;
+    }
+
+  fdstream = make_filedesc_input_stream (fd, 0, -1, 0);
+  Lstream_set_buffering (XLSTREAM (fdstream), LSTREAM_UNBUFFERED, 0);
+  instream =
+    make_coding_input_stream
+      (XLSTREAM (fdstream), standard_doc_file ? Qescape_quoted : Qbinary,
+       CODING_DECODE, 0);
+  Lstream_set_buffering (XLSTREAM (instream), LSTREAM_UNBUFFERED, 0);
+
+  space_left = buffer_size - (p - buffer);
+  while (space_left > 0)
+    {
+      int nread;
+
+      nread = Lstream_read (XLSTREAM (instream), p, space_left);
+      if (nread < 0)
+	{
+	  return_me = list1 (build_msg_string
+			     ("Read error on documentation file"));
+	  goto done;
+	}
+
+      p[nread] = 0;
+
+      if (!nread)
+	break;
+
+      p += nread;
+      space_left = buffer_size - (p - buffer);
+    }
+
+  /* First, search backward for the "\037S" that marks the beginning of the
+     file name, then search forward from that to the newline or to the end
+     of the buffer. */
+  from = p; 
+
+  while (from > buf)
+    {
+      --from;
+      if (seenS)
+	{
+	  if ('\037' == *from) 
+	    {
+	      /* Got a file name; adjust `from' to point to it, break out of
+		 the loop.  */
+	      from += 2;
+	      break; 
+	    }
+	}
+      /* Is *from 'S' ? */
+      seenS = ('S' == *from);
+    }
+
+  if (buf == from)
+    {
+      /* We've scanned back to the beginning of the buffer without hitting
+	 the file name. Either the file name plus the symbol name is longer
+	 than DOC_MAX_FILENAME_LENGTH--which shouldn't happen, because it'll
+	 trigger an assertion failure in make-docfile, the DOC file is
+	 corrupt, or it was produced by a version of make-docfile that
+	 doesn't store the file name with the symbol name and docstring.  */ 
+      return_me = list1 (build_msg_string
+			 ("Object file name not stored in doc file"));
+      goto done;
+    }
+
+  to = from;
+  /* Search for the end of the file name. */
+  while (++to < p)
+    {
+      if ('\n' == *to || '\037' == *to)
+	{
+	  break;
+	}
+    }
+
+  /* Don't require the file name to end in a newline. */
+  return_me = make_string (from, to - from);
+
+ done:
+  if (!NILP (instream))
+    {
+      Lstream_delete (XLSTREAM (instream));
+      Lstream_delete (XLSTREAM (fdstream));
+    }
+
+  UNGCPRO;
+  return return_me;
+}
 
 Lisp_Object
 unparesseuxify_doc_string (int fd, EMACS_INT position,
@@ -287,6 +404,150 @@
   return Fread (string);
 }
 
+static Lisp_Object
+get_object_file_name (Lisp_Object filepos)
+{
+  REGISTER int fd;
+  REGISTER Ibyte *name_nonreloc = 0;
+  EMACS_INT position;
+  Lisp_Object file, tem;
+  Lisp_Object name_reloc = Qnil;
+  int standard_doc_file = 0;
+
+  if (INTP (filepos))
+    {
+      file = Vinternal_doc_file_name;
+      standard_doc_file = 1;
+      position = XINT (filepos);
+    }
+  else if (CONSP (filepos) && INTP (XCDR (filepos)))
+    {
+      file = XCAR (filepos);
+      position = XINT (XCDR (filepos));
+      if (position < 0)
+	position = - position;
+    }
+  else
+    return Qnil;
+
+  if (!STRINGP (file))
+    return Qnil;
+
+  /* Put the file name in NAME as a C string.
+     If it is relative, combine it with Vdoc_directory.  */
+
+  tem = Ffile_name_absolute_p (file);
+  if (NILP (tem))
+    {
+      Bytecount minsize;
+      /* XEmacs: Move this check here.  OK if called during loadup to
+	 load byte code instructions. */
+      if (!STRINGP (Vdoc_directory))
+	return Qnil;
+
+      minsize = XSTRING_LENGTH (Vdoc_directory);
+      /* sizeof ("../lib-src/") == 12 */
+      if (minsize < 12)
+	minsize = 12;
+      name_nonreloc = alloca_ibytes (minsize + XSTRING_LENGTH (file) + 8);
+      string_join (name_nonreloc, Vdoc_directory, file);
+    }
+  else
+    name_reloc = file;
+
+  fd = qxe_open (name_nonreloc ? name_nonreloc :
+		 XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0);
+  if (fd < 0)
+    {
+      if (purify_flag)
+	{
+	    /* sizeof ("../lib-src/") == 12 */
+	  name_nonreloc = alloca_ibytes (12 + XSTRING_LENGTH (file) + 8);
+	  /* Preparing to dump; DOC file is probably not installed.
+	     So check in ../lib-src. */
+	  qxestrcpy_ascii (name_nonreloc, "../lib-src/");
+	  qxestrcat (name_nonreloc, XSTRING_DATA (file));
+
+	  fd = qxe_open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0);
+	}
+
+      if (fd < 0)
+	report_file_error ("Cannot open doc string file",
+			   name_nonreloc ? build_intstring (name_nonreloc) :
+			   name_reloc);
+    }
+
+  tem = extract_object_file_name (fd, position, name_nonreloc, name_reloc,
+			      standard_doc_file);
+  retry_close (fd);
+
+  if (!STRINGP (tem))
+    signal_error_1 (Qinvalid_byte_code, tem);
+
+  return tem;
+}
+
+
+static void
+weird_doc (Lisp_Object sym, const CIbyte *weirdness, const CIbyte *type,
+	   int pos)
+{
+  if (!strcmp (weirdness, GETTEXT ("duplicate"))) return;
+  message ("Note: Strange doc (%s) for %s %s @ %d",
+           weirdness, type, XSTRING_DATA (XSYMBOL (sym)->name), pos);
+}
+
+DEFUN ("built-in-symbol-file", Fbuilt_in_symbol_file, 1, 1, 0, /*
+Return the C source file built-in symbol SYM comes from. 
+Don't use this.  Use the more general `symbol-file' (q.v.) instead. 
+*/
+       (symbol))
+{
+  /* This function can GC */
+  Lisp_Object fun;
+  Lisp_Object filename = Qnil;
+
+  if (EQ(Ffboundp(symbol), Qt))
+    {
+      fun = Findirect_function (symbol);
+
+      if (SUBRP (fun))
+	{
+	  if (XSUBR (fun)->doc == 0)
+	    return Qnil;
+
+	  if ((EMACS_INT) XSUBR (fun)->doc >= 0)
+	    {
+	      weird_doc (symbol, "No file info available for function",
+			 GETTEXT("function"), 0);
+	      return Qnil;
+	    }
+	  else
+	    filename = get_object_file_name 
+	      (make_int (- (EMACS_INT) XSUBR (fun)->doc));
+	}
+    }
+  else if (EQ(Fboundp(symbol), Qt))
+    {
+      Lisp_Object doc_offset = Fget (symbol, Qvariable_documentation, Qnil);
+
+      if (!NILP(doc_offset)) 
+	{
+	  if (INTP(doc_offset))
+	    {
+	      filename = get_object_file_name 
+		(XINT (doc_offset) > 0 ? doc_offset
+		 : make_int (- XINT (doc_offset)));
+	    }
+	  else if (CONSP(doc_offset))
+	    {
+	      filename = get_object_file_name(doc_offset);
+	    }
+	}
+    }
+  return filename;
+}
+
 DEFUN ("documentation", Fdocumentation, 1, 2, 0, /*
 Return the documentation string of FUNCTION.
 Unless a non-nil second argument RAW is given, the
@@ -419,14 +680,6 @@
   return doc;
 }
 
-static void
-weird_doc (Lisp_Object sym, const CIbyte *weirdness, const CIbyte *type,
-	   int pos)
-{
-  if (!strcmp (weirdness, GETTEXT ("duplicate"))) return;
-  message ("Note: Strange doc (%s) for %s %s @ %d",
-           weirdness, type, XSTRING_DATA (XSYMBOL (sym)->name), pos);
-}
 
 DEFUN ("Snarf-documentation", Fsnarf_documentation, 1, 1, 0, /*
 Used during Emacs initialization, before dumping runnable Emacs,
@@ -1008,6 +1261,7 @@
 void
 syms_of_doc (void)
 {
+  DEFSUBR (Fbuilt_in_symbol_file);
   DEFSUBR (Fdocumentation);
   DEFSUBR (Fdocumentation_property);
   DEFSUBR (Fsnarf_documentation);
--- a/src/symbols.c	Sat Apr 29 14:36:57 2006 +0000
+++ b/src/symbols.c	Sat Apr 29 16:15:31 2006 +0000
@@ -719,6 +719,18 @@
   return newdef;
 }
 
+DEFUN ("subr-name", Fsubr_name, 1, 1, 0, /*
+Return name of function SUBR.
+SUBR must be a built-in function.  
+*/
+       (subr))
+{
+  const char *name;
+  if (!SUBRP (subr))
+    wrong_type_argument (Qsubrp, subr);
+  name = XSUBR (subr)->name;
+  return make_string (name, strlen (name));
+}
 
 DEFUN ("setplist", Fsetplist, 2, 2, 0, /*
 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
@@ -3706,6 +3718,7 @@
   DEFSUBR (Ffset);
   DEFSUBR (Fdefine_function);
   Ffset (intern ("defalias"), intern ("define-function"));
+  DEFSUBR (Fsubr_name);
   DEFSUBR (Fsetplist);
   DEFSUBR (Fsymbol_value_in_buffer);
   DEFSUBR (Fsymbol_value_in_console);
--- a/src/sysfile.h	Sat Apr 29 14:36:57 2006 +0000
+++ b/src/sysfile.h	Sat Apr 29 16:15:31 2006 +0000
@@ -447,8 +447,6 @@
      separator.
 */
 
-#ifdef emacs
-
 /* We used to put some of this stuff in the s+m files for the various
    types of MS Windows, but that's disingenuous.  The various definitions
    above were specifically created for MS Windows, and the "if not, then
@@ -519,6 +517,12 @@
 
 #endif /* WIN32_ANY */
 
+/* How long can a source filename be in DOC (including "\037S" at the start
+   and "\n" at the end) ? */
+#define DOC_MAX_FILENAME_LENGTH 2048
+
+#ifdef emacs
+
 #if defined (WIN32_NATIVE)
 #define PATHNAME_RESOLVE_LINKS(path, pathout)		\
 do							\