changeset 4545:8775d3b54874

Merge after pull.
author Stephen J. Turnbull <stephen@xemacs.org>
date Mon, 29 Dec 2008 23:36:00 +0900
parents dc578683fddd (current diff) 0c410b5b387a (diff)
children 44129f301385
files
diffstat 10 files changed, 206 insertions(+), 82 deletions(-) [+]
line wrap: on
line diff
--- a/lib-src/ChangeLog	Mon Dec 29 21:49:01 2008 +0900
+++ b/lib-src/ChangeLog	Mon Dec 29 23:36:00 2008 +0900
@@ -1,3 +1,13 @@
+2008-12-27  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* make-docfile.c (main): Allow more than one -d argument, followed
+	by a directory to change to.
+	(put_filename): Don't strip directory information; with previous
+	change, allows retrieval of Lisp function and variable origin
+	files from #'built-in-symbol-file relative to lisp-directory. 
+	(scan_lisp_file): Don't add an extraneous newline after the file
+	name, put_filename has added the newline already. 
+
 2008-05-21  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* make-mswin-unicode.pl:
--- a/lib-src/make-docfile.c	Mon Dec 29 21:49:01 2008 +0900
+++ b/lib-src/make-docfile.c	Mon Dec 29 23:36:00 2008 +0900
@@ -233,6 +233,15 @@
 	      err_count += scan_file (arg);
 	    }
 	}
+      else if (argc > i + 1 && !strcmp (argv[i], "-d"))
+        {
+          /* XEmacs change; allow more than one chdir. 
+             The idea is that the second chdir is to source-lisp, and that
+             any Lisp files not under there have the full path specified.  */
+          i += 1;
+          chdir (argv[i]);
+          continue;
+        }
       else
 	{
 	  int j;
@@ -269,14 +278,16 @@
 static void
 put_filename (const char *filename)
 {
+  /* XEmacs change; don't strip directory information. */
+#if 0
   const char *tmp;
 
-  /* Why are we cutting this off? */
   for (tmp = filename; *tmp; tmp++)
     {
       if (IS_DIRECTORY_SEP(*tmp))
 	filename = tmp + 1;
     }
+#endif 
 
   /* <= because sizeof includes the nul byte at the end. Not quite right,
      because it should include the length of the symbol + "\037[VF]" instead
@@ -1390,7 +1401,6 @@
 	 backslash-newline) have already been read.  */
 
       put_filename (filename);	/* XEmacs addition */
-      putc ('\n', outfile);	/* XEmacs addition */
       putc (037, outfile);
       putc (type, outfile);
       fprintf (outfile, "%s\n", buffer);
--- a/lisp/ChangeLog	Mon Dec 29 21:49:01 2008 +0900
+++ b/lisp/ChangeLog	Mon Dec 29 23:36:00 2008 +0900
@@ -1,3 +1,39 @@
+2008-12-27  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* loadhist.el (symbol-file): 
+	Use #'defun*, not #'defun, to allow the checks for autoloaded
+	functions and variables to call #'return-from correctly. Use
+	#'return-from instead of #'return throughout the function. 
+
+2008-12-27  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* loadup.el (load-history): 
+	Add the contents of current-load-list to load-history before
+	clearing it. Move the variable declarations earlier in the file to
+	a format understood by make-docfile.c. 
+	* custom.el (custom-declare-variable): Add the variable's symbol
+	to the current file's load history entry correctly, don't use a
+	cons. Eliminate a comment that we don't need to worry about, we
+	don't need to check the `initialized' C variable in Lisp.
+	* bytecomp.el (byte-compile-output-file-form): 
+	Merge Andreas Schwab's pre-GPLv3 GNU change of 19970831 here;
+	treat #'custom-declare-variable correctly, generating the
+	docstrings in a format understood by make-docfile.c.
+	* loadhist.el (symbol-file): Correct behaviour for checking
+	autoloaded macros and functions when supplied with a TYPE
+	argument. Accept fully-qualified paths from
+	#'built-in-symbol-file; if a path is not fully-qualified, return
+	it relative to lisp-directory if the filename corresponds to a
+	Lisp file, and relative to (concat source-directory "/src/")
+	otherwise.
+	* make-docfile.el (preloaded-file-list): 
+	Rationalise some let bindings a little. Use the "-d" argument to
+	make-docfile.c to supply Lisp paths relative to lisp-directory,
+	not absolutely. Add in loadup.el explicitly to the list of files
+	to be processed by make-docfile.c--it doesn't make sense to add it
+	to preloaded-file-list, since that is used for purposes of
+	byte-compilation too. 
+
 2008-12-22  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* loadhist.el (symbol-file): 
--- a/lisp/bytecomp.el	Mon Dec 29 21:49:01 2008 +0900
+++ b/lisp/bytecomp.el	Mon Dec 29 23:36:00 2008 +0900
@@ -1881,10 +1881,12 @@
   ;; defalias calls are output directly by byte-compile-file-form-defmumble;
   ;; it does not pay to first build the defalias in defmumble and then parse
   ;; it here.
-  (if (and (memq (car-safe form) '(defun defmacro defvar defconst autoload))
+  (if (and (memq (car-safe form) '(defun defmacro defvar defconst autoload
+				   custom-declare-variable))
 	   (stringp (nth 3 form)))
       (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
-				   (eq (car form) 'autoload))
+				   (memq (car form)
+					 '(autoload custom-declare-variable)))
     (let ((print-escape-newlines t)
 	  (print-length nil)
 	  (print-level nil)
--- a/lisp/custom.el	Mon Dec 29 21:49:01 2008 +0900
+++ b/lisp/custom.el	Mon Dec 29 23:36:00 2008 +0900
@@ -203,9 +203,7 @@
     ;; Do the actual initialization.
     (unless custom-dont-initialize
       (funcall initialize symbol default)))
-  ;; #### This is a rough equivalent of LOADHIST_ATTACH.  However,
-  ;; LOADHIST_ATTACH also checks for `initialized'.
-  (push (cons 'defvar symbol) current-load-list)
+  (push symbol current-load-list)
   (run-hooks 'custom-define-hook)
   symbol)
 
--- a/lisp/loadhist.el	Mon Dec 29 21:49:01 2008 +0900
+++ b/lisp/loadhist.el	Mon Dec 29 23:36:00 2008 +0900
@@ -39,7 +39,9 @@
 ;; load-history is a list of entries that look like this:
 ;; ("outline" outline-regexp ... (require . wid-edit) ... (provide . outline) ...)
 
-(defun symbol-file (sym &optional type)
+;; XEmacs; this function is in subr.el in GNU, and does not deal with
+;; built-in symbols.
+(defun* symbol-file (sym &optional type)
   "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.
 
@@ -52,40 +54,44 @@
 return faces created with `make-face' or `copy-face', just those created
 with `defface' and `custom-declare-face'."
   (interactive "SFind source file for symbol: ") ; XEmacs
-  (block look-up-symbol-file
-    (let (built-in-file autoload-cons symbol-details)
-      (when (and 
-             (eq 'autoload
-                 (car-safe (setq autoload-cons
-                                 (and (fboundp sym)
-                                      (symbol-function sym)))))
-             (or (and (or (null type) (eq 'defvar type))
-                      (eq (fifth autoload-cons) 'keymap))
-                 (and (or (null type) (eq 'defvar type))
-                    (memq (fifth autoload-cons) '(nil macro)))))
-        (return-from look-up-symbol-file
-          (locate-library (second autoload-cons))))
-      (cond ((eq 'defvar type)
-             ;; Load history entries corresponding to variables are just
-             ;; symbols.
-             (dolist (entry load-history)
-               (when (memq sym (cdr entry))
-                 (return-from look-up-symbol-file (car entry)))))
-            ((not (null type))
-             ;; Non-variables have the type stored as the car of the entry. 
-             (dolist (entry load-history)
-               (when (and (setq symbol-details (rassq sym (cdr entry)))
-                          (eq type (car symbol-details)))
-                 (return-from look-up-symbol-file (car entry)))))
-            (t
-             ;; If TYPE hasn't been specified, we need to check both for
-             ;; variables and other symbols.
-             (dolist (entry load-history)
-               (when (or (memq sym (cdr entry))
-                         (rassq sym (cdr entry)))
-                 (return-from look-up-symbol-file (car entry))))))
-      (setq built-in-file (built-in-symbol-file sym type))
-      (if built-in-file (concat source-directory "/src/" built-in-file)))))
+  (let (built-in-file autoload-cons symbol-details)
+    (cond ((and (eq 'autoload
+                    (car-safe
+                     (setq autoload-cons
+                           (and (fboundp sym) (symbol-function sym)))))
+                (or (and (or (null type) (eq 'defvar type))
+                         (eq (fifth autoload-cons) 'keymap))
+                    (and (or (null type) (eq 'defun type))
+                         (memq (fifth autoload-cons) '(nil macro)))))
+           (return-from symbol-file (locate-library (second autoload-cons))))
+          ((eq 'defvar type)
+           ;; Load history entries corresponding to variables are just
+           ;; symbols.
+           (dolist (entry load-history)
+             (when (memq sym (cdr entry))
+               (return-from symbol-file (car entry)))))
+           ((not (null type))
+            ;; Non-variables have the type stored as the car of the entry. 
+            (dolist (entry load-history)
+              (when (and (setq symbol-details (rassq sym (cdr entry)))
+                         (eq type (car symbol-details)))
+                (return-from symbol-file (car entry)))))
+          (t
+           ;; If TYPE hasn't been specified, we need to check both for
+           ;; variables and other symbols.
+           (dolist (entry load-history)
+             (when (or (memq sym (cdr entry))
+                       (rassq sym (cdr entry)))
+               (return-from symbol-file (car entry))))))
+    (when (setq built-in-file (built-in-symbol-file sym type))
+      (if (equal built-in-file (file-truename built-in-file))
+          ;; Probably a full path name:
+          built-in-file
+        ;; This is a bit heuristic, but shouldn't realistically be a
+        ;; problem:
+        (if (string-match "\.elc?$" built-in-file)
+            (concat lisp-directory built-in-file)
+          (concat source-directory "/src/" built-in-file))))))
 
 (defun feature-symbols (feature)
   "Return the file and list of symbols associated with a given FEATURE."
--- a/lisp/loadup.el	Mon Dec 29 21:49:01 2008 +0900
+++ b/lisp/loadup.el	Mon Dec 29 23:36:00 2008 +0900
@@ -31,6 +31,12 @@
 ;; If you are wanting to add files to be dumped into your local version of
 ;; XEmacs, DO NOT add them here.  Use site-init.el or site-load.el instead.
 
+;; ***Note the docstrings for the variables in this file. They follow the
+;; conventions described in lib-src/make-docfile.c, and any new variables or
+;; functions added to this file should follow those conventions too, since
+;; this file is always loaded uncompiled, and the byte-compiler never gets a
+;; chance to format the docstrings in the way make-docfile.c understands.
+
 ;; This is loaded into a bare XEmacs to make a dumpable one.
 
 ;;; Code:
@@ -47,27 +53,27 @@
 (when (fboundp 'error)
   (error "loadup.el already loaded!"))
 
-(defconst running-xemacs t
-  "Non-nil when the current emacs is XEmacs.")
+(defconst running-xemacs t "\
+Non-nil when the current emacs is XEmacs.")
 
 ;; Can't make this constant for now because it causes an error in
 ;; update-elc.el. 
-(defvar source-lisp (file-name-directory (expand-file-name
-					  (nth 2 command-line-args)))
-  "Root of tree containing the Lisp source code for the current build. 
+(defvar source-lisp (file-name-directory (expand-file-name (nth 2 command-line-args))) "\
+Root of tree containing the Lisp source code for the current build. 
 Differs from `lisp-directory' if this XEmacs has been installed. ")
 
-(defconst build-directory (expand-file-name ".." invocation-directory)
-  "Root of tree containing object files and executables produced by build. 
+(defconst build-directory (expand-file-name ".." invocation-directory) "\
+Root of tree containing object files and executables produced by build. 
 Differs from `source-directory' if configured with --srcdir option, a practice 
 recommended for developers.")
 
-(defconst source-directory (expand-file-name ".." source-lisp)
-  "Root of tree containing source code for the current build. 
+(defconst source-directory (expand-file-name ".." source-lisp)  "\
+Root of tree containing source code for the current build. 
 Used during loadup and for documenting source of symbols defined in C.")
 
-(defvar preloaded-file-list nil
-  "List of files preloaded into the XEmacs binary image.")
+(defvar preloaded-file-list nil "\
+List of Lisp files preloaded into the XEmacs binary image,
+with the exception of `loadup.el'.")
 
 ;(start-profiling)
 
@@ -206,7 +212,15 @@
 ;; See also "site-load" above.
 (when (stringp site-start-file)
   (load "site-init" t))
-(setq current-load-list nil)
+;; Add information from this file to the load history:
+(setq load-history (cons (nreverse current-load-list) load-history)
+      ;; Clear current-load-list; this (and adding information to
+      ;; load-history) is normally done in lread.c after reading the
+      ;; entirety of a file, something which never happens for loadup.el.
+      current-load-list nil)
+;; Make the path to this file look a little nicer: 
+(setcar (car load-history) (file-truename (caar load-history)))
+
 (garbage-collect)
 
 ;;; At this point, we're ready to resume undo recording for scratch.
--- a/lisp/make-docfile.el	Mon Dec 29 21:49:01 2008 +0900
+++ b/lisp/make-docfile.el	Mon Dec 29 23:36:00 2008 +0900
@@ -151,36 +151,50 @@
 (load "setup-paths.el")
 (load "raw-process.el")
 
-(let (preloaded-file-list)
+(let (preloaded-file-list arg0 arg package-preloaded-file-list)
   (load (expand-file-name "dumped-lisp.el" source-lisp))
 
-  (let ((package-preloaded-file-list
-	 (packages-collect-package-dumped-lisps late-package-load-path)))
-
-    (setq preloaded-file-list
-	  (append package-preloaded-file-list
-		  preloaded-file-list
-		  packages-hardcoded-lisp)))
+  (setq package-preloaded-file-list
+	(packages-collect-package-dumped-lisps late-package-load-path)
+	preloaded-file-list
+	(append package-preloaded-file-list
+		preloaded-file-list
+		packages-hardcoded-lisp)
+	  
+	processed (cons "-d" processed)
+	processed (cons source-lisp processed)
+	;; Include loadup.el, which is never in preloaded-file-list:
+	processed (cons "loadup.el" processed))
 
   (while preloaded-file-list
-    (let ((arg0 (packages-add-suffix (car preloaded-file-list)))
-	  arg)
-      (setq arg (locate-library arg0))
-      (if (null arg)
-	  (progn
+    (setq arg0 (packages-add-suffix (car preloaded-file-list))
+	  arg (locate-library arg0))
+    (if (null arg)
+	(progn
 	  (message "Error: dumped file %s does not exist" arg0)
 	  ;; Uncomment in case of difficulties
-	  ;;(message "late-package-hierarchies: %S" late-package-hierarchies)
-	  ;;(message "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name #'paths-emacs-root-p))
-	  ;;(message "guessed-data-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name #'paths-emacs-data-root-p))
-	  )
-	(if (null (member arg processed))
-	    (progn
-	      (if (and (null docfile-out-of-date)
-		       (file-newer-than-file-p arg docfile))
-		  (setq docfile-out-of-date t))
-	      (setq processed (cons arg processed)))))
-      (setq preloaded-file-list (cdr preloaded-file-list)))))
+          ;(message "late-package-hierarchies: %S"
+          ;         late-package-hierarchies)
+          ;(message "guessed-roots: %S" (paths-find-emacs-roots
+          ;                              invocation-directory
+          ;                              invocation-name
+          ;                              #'paths-emacs-root-p))
+          ;(message "guessed-data-roots: %S" (paths-find-emacs-roots
+          ;                                   invocation-directory
+          ;                                   invocation-name
+          ;                                   #'paths-emacs-data-root-p))
+          )
+      (when (equal arg (expand-file-name arg0 source-lisp))
+	;; Use relative paths where possible, since this makes file lookup
+	;; in an installed XEmacs easier:
+	(setq arg arg0))
+      (if (null (member arg processed))
+	  (progn
+	    (if (and (null docfile-out-of-date)
+		     (file-newer-than-file-p arg docfile))
+		(setq docfile-out-of-date t))
+	    (setq processed (cons arg processed)))))
+    (setq preloaded-file-list (cdr preloaded-file-list))))
 
 ;; Finally process the list of site-loaded files.
 (if site-file-list
--- a/src/ChangeLog	Mon Dec 29 21:49:01 2008 +0900
+++ b/src/ChangeLog	Mon Dec 29 23:36:00 2008 +0900
@@ -1,3 +1,13 @@
+2008-12-27  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* doc.c (Fbuilt_in_symbol_file): 
+	Return a subr's filename immediately if we've found it. Check for
+	compiled function and compiled macro docstrings in DOC too, and
+	return them if they exist. 
+	The branch of the if statement focused on functions may have
+	executed, but we may still want to check variable bindings; an
+	else clause isn't appropriate.
+
 2008-12-27  Vin Shelton  <acs@xemacs.org>
 
 	* syswindows.h: Don't define wide character interfaces for Cygwin
--- a/src/doc.c	Mon Dec 29 21:49:01 2008 +0900
+++ b/src/doc.c	Mon Dec 29 23:36:00 2008 +0900
@@ -531,11 +531,33 @@
 	      return Qnil;
 	    }
 	  else
-	    filename = get_object_file_name 
-	      (make_int (- (EMACS_INT) XSUBR (fun)->doc));
+	    {
+	      filename = get_object_file_name 
+		(make_int (- (EMACS_INT) XSUBR (fun)->doc));
+	      return filename;
+	    }
+	}
+
+      if (COMPILED_FUNCTIONP (fun) || (CONSP(fun) &&
+				       (EQ (Qmacro, Fcar_safe (fun)))
+				       && (fun = Fcdr_safe (fun),
+					   COMPILED_FUNCTIONP (fun))))
+	{
+	  Lisp_Object tem;
+	  Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
+
+	  if (! (f->flags.documentationp))
+	    return Qnil;
+	  tem = compiled_function_documentation (f);
+	  if (NATNUMP (tem) || CONSP (tem))
+	    {
+	      filename = get_object_file_name (tem);
+	      return filename;
+	    }
 	}
     }
-  else if (EQ(Fboundp(symbol), Qt) && (EQ(type, Qnil) || EQ(type, Qdefvar)))
+
+  if (EQ(Fboundp(symbol), Qt) && (EQ(type, Qnil) || EQ(type, Qdefvar)))
     {
       Lisp_Object doc_offset = Fget (symbol, Qvariable_documentation, Qnil);
 
@@ -551,9 +573,11 @@
 	    {
 	      filename = get_object_file_name(doc_offset);
 	    }
+	  return filename;
 	}
     }
-  return filename;
+
+  return Qnil;
 }
 
 DEFUN ("documentation", Fdocumentation, 1, 2, 0, /*