;;; 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:
(if (and (file-exists-p full-path) overwrite)
(delete-file full-path))
(copy-file src-file full-path t t)
+ (set-file-modes full-path install-overwritten-file-modes)
(if move
(catch 'tag
(while (and (file-exists-p src-file)
;;; @@ install Emacs Lisp files
;;;
-(defun install-elisp-module (module src dest &optional just-print)
+(defun install-elisp-module (module src dest &optional just-print del-elc)
(let (el-file elc-file)
(let ((name (symbol-name module)))
(setq el-file (concat name ".el"))
(if (file-exists-p full-path)
(delete-file full-path))
(copy-file src-file full-path t t)
+ (set-file-modes full-path install-overwritten-file-modes)
(princ (format "%s -> %s\n" el-file dest)))))
(setq src-file (expand-file-name elc-file src))
(if (not (file-exists-p src-file))
- nil
+ (let ((full-path (expand-file-name elc-file dest)))
+ (if (and del-elc (file-exists-p full-path))
+ (if just-print
+ (princ (format "%s -> to be deleted\n" full-path))
+ (delete-file full-path)
+ (princ (format "%s -> deleted\n" full-path)))))
(if just-print
(princ (format "%s -> %s\n" elc-file dest))
(let ((full-path (expand-file-name elc-file dest)))
(if (file-exists-p full-path)
(delete-file full-path))
(copy-file src-file full-path t t)
+ (set-file-modes full-path install-overwritten-file-modes)
(catch 'tag
(while (file-exists-p src-file)
(condition-case err
(error (princ (format "%s\n" (nth 1 err)))))))
(princ (format "%s -> %s\n" elc-file dest))))))))
-(defun install-elisp-modules (modules src dest &optional just-print)
+(defun install-elisp-modules (modules src dest &optional just-print del-elc)
(or just-print
(file-exists-p dest)
(make-directory dest t))
(mapcar
(function
(lambda (module)
- (install-elisp-module module src dest just-print)))
+ (install-elisp-module module src dest just-print del-elc)))
modules))
(defvar install-prefix
(if (or (<= emacs-major-version 18)
(featurep 'xemacs)
- (and (boundp 'system-configuration-options) ; 19.29 or later
- (string= system-configuration-options "NT"))) ; for Meadow
+ (featurep 'meadow) ; for Meadow
+ (and (eq system-type 'windows-nt) ; for NTEmacs
+ (>= emacs-major-version 20)))
(expand-file-name "../../.." exec-directory)
(expand-file-name "../../../.." data-directory)))
;; 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 "^"
- (expand-file-name (concat ".*/" elisp-prefix)
- 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
- (if (string-match regexp (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)
- (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))