Mercurial > hg > xemacs-beta

changeset 5020:eadd99984bfb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Tue, 09 Feb 2010 03:53:52 -0600
parents d7cc9553d3eb (current diff) ecdc03ef6e12 (diff)
children 4e784bfabae7
files lisp/ChangeLog src/ChangeLog src/lisp.h
diffstat 10 files changed, 108 insertions(+), 76 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Tue Feb 09 00:30:59 2010 -0600
+++ b/lisp/ChangeLog	Tue Feb 09 03:53:52 2010 -0600
@@ -5,6 +5,25 @@
 	for a function since it doesn't provide this info and load-history
 	already does provide it.
 
+2010-02-07  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* make-docfile.el (format-decode): Remove this temporary function
+	definition, now we check the symbol is bound in fileio.c
+	* version.el (format-decode): Ditto.
+	* format.el (car-less-than-car, cdr-less-than-cdr): Move these
+	here from fileio.c, now they are only called once format.el is
+	available.
+
+2010-02-07  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* setup-paths.el (paths-find-emacs-roots)
+	(paths-construct-info-path):
+	* packages.el (packages-find-installation-package-directories):
+	#'union doesn't guarantee that it will preserve the relative order
+	of elements in its arguments; use #'delete-duplicates
+	instead. Thank you for the bug reports, Robert Pluim, Stephen
+	Turnbull.
+
 2010-02-06  Ben Wing  <ben@xemacs.org>
 
 	* unicode.el:
--- a/lisp/make-docfile.el	Tue Feb 09 00:30:59 2010 -0600
+++ b/lisp/make-docfile.el	Tue Feb 09 03:53:52 2010 -0600
@@ -78,11 +78,6 @@
 
 ;; (message (concat "Options: " (prin1-to-string options)))
 
-;; insert-file-contents-internal calls out to `format-decode' afterwards,
-;; so it must be defined.  if non-zero, it tries to do a bunch more stuff
-;; so say, "NOOOOOOOOOOOOO!  Basta!  Ca soufit!   Enough, already, OK?"
-(defun format-decode (fuck me harder) 0)
-
 ;; Next process the list of C files.
 (defun process-args (args)
   (while args
--- a/lisp/packages.el	Tue Feb 09 00:30:59 2010 -0600
+++ b/lisp/packages.el	Tue Feb 09 03:53:52 2010 -0600
@@ -385,8 +385,10 @@
 (defun packages-find-installation-package-directories (roots)
   "Find the package directories in the XEmacs installation.
 ROOTS is a list of installation roots."
-  (union (paths-find-version-directories roots (list "") nil nil nil t)
-         (paths-find-site-directories roots (list "") nil) :test #'equal))
+  (delete-duplicates
+   (nconc (paths-find-version-directories roots (list "") nil nil nil t)
+          (paths-find-site-directories roots (list "") nil))
+   :test #'equal))
 
 (defun packages-find-package-hierarchies (package-directories &optional envvar default)
   "Find package hierarchies in a list of package directories.
--- a/lisp/setup-paths.el	Tue Feb 09 00:30:59 2010 -0600
+++ b/lisp/setup-paths.el	Tue Feb 09 03:53:52 2010 -0600
@@ -142,17 +142,19 @@
 				       invocation-name
 				       root-p))
 	 (potential-installation-roots
-	  (union
-	   (and configure-exec-prefix-directory
-		(list (file-name-as-directory
-		       configure-exec-prefix-directory)))
-	   (and configure-prefix-directory
-		(list (file-name-as-directory
-		       configure-prefix-directory)))
+	  (delete-duplicates
+           (append
+            (and configure-exec-prefix-directory
+                 (list (file-name-as-directory
+                        configure-exec-prefix-directory)))
+            (and configure-prefix-directory
+                 (list (file-name-as-directory
+                        configure-prefix-directory))))
            :test #'equal))
 	 (installation-roots
 	  (remove-if-not root-p potential-installation-roots)))
-    (union invocation-roots installation-roots :test #'equal)))
+    (delete-duplicates (nconc invocation-roots installation-roots)
+                       :test #'equal)))
 
 (defun paths-find-site-lisp-directory (roots)
   "Find the site Lisp directory of the XEmacs hierarchy.
@@ -260,24 +262,26 @@
 LAST-PACKAGE-HIERARCHIES are lists of package hierarchy roots,
 respectively."
   (let ((info-path-envval (getenv "INFOPATH")))
-    (union
-     (append
-      (let ((info-directory
-	     (paths-find-version-directory roots (list "info")
-					   nil nil
-					   configure-info-directory)))
-	(and info-directory
-	     (list info-directory)))
-      (packages-find-package-info-path early-package-hierarchies)
-      (packages-find-package-info-path late-package-hierarchies)
-      (packages-find-package-info-path last-package-hierarchies)
-      (and info-path-envval
-	   (paths-decode-directory-path info-path-envval 'drop-empties)))
-     (and (null info-path-envval)
-	  (union
-	   (paths-directories-which-exist configure-info-path)
-	   (paths-directories-which-exist paths-default-info-directories)
-           :test #'equal))
+    (delete-duplicates
+     (nconc
+      (append
+       (let ((info-directory
+              (paths-find-version-directory roots (list "info")
+                                            nil nil
+                                            configure-info-directory)))
+         (and info-directory
+              (list info-directory)))
+       (packages-find-package-info-path early-package-hierarchies)
+       (packages-find-package-info-path late-package-hierarchies)
+       (packages-find-package-info-path last-package-hierarchies)
+       (and info-path-envval
+            (paths-decode-directory-path info-path-envval 'drop-empties)))
+      (and (null info-path-envval)
+           (delete-duplicates
+            (nconc
+             (paths-directories-which-exist configure-info-path)
+             (paths-directories-which-exist paths-default-info-directories))
+           :test #'equal)))
      :test #'equal)))
 
 (defun paths-find-doc-directory (roots)
--- a/lisp/subr.el	Tue Feb 09 00:30:59 2010 -0600
+++ b/lisp/subr.el	Tue Feb 09 03:53:52 2010 -0600
@@ -1777,4 +1777,19 @@
           'many)
          (t (subr-max-args subr)))))
 
+;; XEmacs; move these here from C. Would be nice to drop them entirely, but
+;; they're used reasonably often, since they've been around for a long time
+;; and they're portable to GNU.
+
+;; Used in fileio.c if format-annotate-function has a function binding
+;; (which it won't have before this file is loaded):
+(defun car-less-than-car (a b)
+  "Return t if the car of A is numerically less than the car of B."
+  (< (car a) (car b)))
+
+;; Used in packages.
+(defun cdr-less-than-cdr (a b)
+  "Return t if (cdr A) is numerically less than (cdr B)."
+  (< (cdr a) (cdr b)))
+
 ;;; subr.el ends here
--- a/lisp/version.el	Tue Feb 09 00:30:59 2010 -0600
+++ b/lisp/version.el	Tue Feb 09 03:53:52 2010 -0600
@@ -152,9 +152,6 @@
   (save-current-buffer
     (set-buffer (get-buffer-create (generate-new-buffer-name
 				    " *temp*")))
-    ;; insert-file-contents-internal bogusly calls
-    ;; format-decode without checking if it's defined.
-    (fset 'format-decode #'(lambda (f l &optional v) l))
     (insert-file-contents-internal
      (expand-file-name "Installation" build-directory)
      ;; Relies on our working out the system coding system
@@ -164,7 +161,6 @@
      ;; mule/general-late.el, after all the dumped coding systems have been
      ;; loaded.
      'binary)
-    (fmakunbound 'format-decode)
     (prog1 (buffer-substring)
       (kill-buffer (current-buffer))))
   "Description of XEmacs installation.
@@ -175,4 +171,4 @@
 occasionally used, in a way the XEmacs developers don't endorse, to work out
 version information.  ")
 
-;;; version.el ends here
\ No newline at end of file
+;;; version.el ends here
--- a/src/ChangeLog	Tue Feb 09 00:30:59 2010 -0600
+++ b/src/ChangeLog	Tue Feb 09 03:53:52 2010 -0600
@@ -299,6 +299,26 @@
 	GET_VOID_FROM_LISP to make sure the same value comes back that
 	was put in.
 
+2010-02-08  Vin Shelton  <acs@xemacs.org>
+
+	* nt.c (open_unc_volume): lpRemoteName is an XELPTSTR.
+
+2010-02-07  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* lisp.h (Dynarr_verify, Dynarr_verify_mod):
+	If ERROR_CHECK_STRUCTURES is not defined, cast the argument in
+	these two macros; fixes the g++ build.
+
+2010-02-07  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* fileio.c (Finsert_file_contents_internal):
+	Only call format-decode if it has a function binding.
+	(build_annotations): Only call format-annotate-function if it has
+	a function binding; incidentally only calling #'car-less-than-car
+	if *it* has a function binding.
+	(syms_of_fileio): #'car-less-than-car and #'cdr-less-than-cdr are
+	now in Lisp.
+
 2010-02-07  Ben Wing  <ben@xemacs.org>
 
 	* fns.c: Qlist, Qstring mistakenly declared twice.
--- a/src/fileio.c	Tue Feb 09 00:30:59 2010 -0600
+++ b/src/fileio.c	Tue Feb 09 03:53:52 2010 -0600
@@ -3268,10 +3268,10 @@
     }
 
   /* Decode file format */
-  if (inserted > 0)
+  if (inserted > 0 && !UNBOUNDP (XSYMBOL_FUNCTION (Qformat_decode)))
     {
-      Lisp_Object insval = call3 (Qformat_decode,
-                                  Qnil, make_int (inserted), visit);
+      Lisp_Object insval = call3 (Qformat_decode, Qnil, make_int (inserted),
+				  visit);
       CHECK_INT (insval);
       inserted = XINT (insval);
     }
@@ -3628,33 +3628,6 @@
   return Qnil;
 }
 
-/* #### This is such a load of shit!!!!  There is no way we should define
-   something so stupid as a subr, just sort the fucking list more
-   intelligently. */
-DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /*
-Return t if (car A) is numerically less than (car B).
-*/
-       (a, b))
-{
-  Lisp_Object objs[2];
-  objs[0] = Fcar (a);
-  objs[1] = Fcar (b);
-  return Flss (2, objs);
-}
-
-/* Heh heh heh, let's define this too, just to aggravate the person who
-   wrote the above comment. */
-DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /*
-Return t if (cdr A) is numerically less than (cdr B).
-*/
-       (a, b))
-{
-  Lisp_Object objs[2];
-  objs[0] = Fcdr (a);
-  objs[1] = Fcdr (b);
-  return Flss (2, objs);
-}
-
 /* Build the complete list of annotations appropriate for writing out
    the text between START and END, by calling all the functions in
    write-region-annotate-functions and merging the lists they return.
@@ -3698,10 +3671,19 @@
     }
 
   /* Now do the same for annotation functions implied by the file-format */
-  if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
-    p = Vauto_save_file_format;
+  if (UNBOUNDP (XSYMBOL_FUNCTION (Qformat_annotate_function)))
+    {
+      p = Qnil;
+    }
+  else if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
+    {
+      p = Vauto_save_file_format;
+    }
   else
-    p = current_buffer->file_format;
+    {
+      p = current_buffer->file_format;
+    }
+
   while (!NILP (p))
     {
       struct buffer *given_buffer = current_buffer;
@@ -3718,6 +3700,7 @@
       annotations = merge (annotations, res, Qcar_less_than_car);
       p = Fcdr (p);
     }
+
   UNGCPRO;
   return annotations;
 }
@@ -4439,8 +4422,6 @@
   DEFSUBR (Ffile_newer_than_file_p);
   DEFSUBR (Finsert_file_contents_internal);
   DEFSUBR (Fwrite_region_internal);
-  DEFSUBR (Fcar_less_than_car); /* Vomitous! */
-  DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */
 #if 0
   DEFSUBR (Fencrypt_string);
   DEFSUBR (Fdecrypt_string);
--- a/src/lisp.h	Tue Feb 09 00:30:59 2010 -0600
+++ b/src/lisp.h	Tue Feb 09 03:53:52 2010 -0600
@@ -1914,8 +1914,8 @@
   dy->locked = 0;				\
 } while (0)
 #else
-#define Dynarr_verify(d) (d)
-#define Dynarr_verify_mod(d) (d)
+#define Dynarr_verify(d) ((Dynarr *) d)
+#define Dynarr_verify_mod(d) ((Dynarr *) d)
 #define Dynarr_lock(d) DO_NOTHING
 #define Dynarr_unlock(d) DO_NOTHING
 #endif /* ERROR_CHECK_STRUCTURES */
--- a/src/nt.c	Tue Feb 09 00:30:59 2010 -0600
+++ b/src/nt.c	Tue Feb 09 03:53:52 2010 -0600
@@ -963,7 +963,7 @@
   nr.dwUsage = RESOURCEUSAGE_CONTAINER; 
   nr.lpLocalName = NULL;
   PATHNAME_CONVERT_OUT (path, extpath);
-  nr.lpRemoteName = (LPTSTR) extpath;
+  nr.lpRemoteName = (XELPTSTR) extpath;
   nr.lpComment = NULL; 
   nr.lpProvider = NULL;