Source

apel / install.el

Diff from to

File install.el

 ;;; install.el --- Emacs Lisp package install utility
 
-;; Copyright (C) 1996,1997,1998,1999,2001 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2006
+;; 	Free Software Foundation, Inc.
 
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Created: 1996/08/18
 ;; Keywords: install, byte-compile, directory detection
 
 
 ;; 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.
 
 ;;; Code:
 
     ;; v18 does not have standard site directory.
     "local.lisp"))
 
+;; Avoid compile warning.
+(eval-when-compile (autoload 'replace-in-string "subr"))
+
 (defun install-detect-elisp-directory (&optional prefix elisp-prefix
 						 allow-version-specific)
   (or prefix
   (or elisp-prefix
       (setq elisp-prefix install-elisp-prefix))
   (or (catch 'tag
-	(let ((rest default-load-path)
-	      (regexp (concat "^"
-			      ;; XEmacs change: handle backslashes (Windows)
-			      (regexp-quote (replace-in-string
-					     (file-name-as-directory
-					      (expand-file-name elisp-prefix))
-					     "\\\\" "/"))
-			      ".*/"
-			      (regexp-quote
-			       (replace-in-string prefix "\\\\" "/"))
-			      "/?$")))
+	(let ((rest (delq nil (copy-sequence default-load-path)))
+	      (regexp
+	       (concat "^"
+		       (regexp-quote (if (featurep 'xemacs)
+					 ;; Handle backslashes (Windows)
+					 (replace-in-string
+					  (file-name-as-directory
+					   (expand-file-name prefix))
+					  "\\\\" "/")
+				       (file-name-as-directory
+					(expand-file-name prefix))))
+		       ".*/"
+		       (regexp-quote
+			(if (featurep 'xemacs)
+			    ;; Handle backslashes (Windows)
+			    (replace-in-string elisp-prefix "\\\\" "/")
+			  elisp-prefix))
+		       "/?$"))
+	      dir)
 	  (while rest
-	    ;; XEmacs change: handle backslashes (Windows)
-	    (if (string-match regexp
-			      (replace-in-string (car rest) "\\\\" "/"))
+	    (setq dir (if (featurep 'xemacs)
+			  ;; Handle backslashes (Windows)
+			  (replace-in-string (car rest) "\\\\" "/")
+			(car rest)))
+	    (if (string-match regexp dir)
 		(if (or allow-version-specific
 			(not (string-match (format "/%d\\.%d"
 						   emacs-major-version
 						   emacs-minor-version)
-					   ;; XEmacs change: handle backslashes
-					   (replace-in-string (car rest)
-							      "\\\\" "/"))))
+					   dir)))
 		    (throw 'tag (car rest))))
 	    (setq rest (cdr rest)))))
       (expand-file-name (concat (if (and (not (featurep 'xemacs))
 ;;; @ for XEmacs package system
 ;;;
 
+(defun install-get-default-package-directory ()
+  (let ((dirs (append
+	       (cond
+		((boundp 'early-package-hierarchies)
+		 (append (if early-package-load-path
+			     early-package-hierarchies)
+			 (if late-package-load-path
+			     late-package-hierarchies)
+			 (if last-package-load-path
+			     last-package-hierarchies)) )
+		((boundp 'early-packages)
+		 (append (if early-package-load-path
+			     early-packages)
+			 (if late-package-load-path
+			     late-packages)
+			 (if last-package-load-path
+			     last-packages)) ))
+	       (if (and (boundp 'configure-package-path)
+			(listp configure-package-path))
+		   (delete "" configure-package-path))))
+	dir)
+    (while (and (setq dir (car dirs))
+		(not (file-exists-p dir)))
+      (setq dirs (cdr dirs)))
+    dir))
+
 (defun install-update-package-files (package dir &optional just-print)
   (cond
    (just-print
     (princ (format "Wrote %s\n"
 		   (expand-file-name "custom-load.elc" dir))))
    (t
-    (setq autoload-package-name package)
-
-    (let ((command-line-args-left (list dir)))
-      (batch-update-directory))
+    (if (fboundp 'batch-update-directory-autoloads)
+	;; XEmacs 21.5.19 and newer.
+	(let ((command-line-args-left (list package dir)))
+	  (batch-update-directory-autoloads))
+      (setq autoload-package-name package)
+      (let ((command-line-args-left (list dir)))
+	(batch-update-directory)))
 
     (let ((command-line-args-left (list dir)))
       (Custom-make-dependencies))