X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=install.el;h=2da8a785e1bfecf72e4cbc94647209c458420ad8;hb=refs%2Fheads%2Fyamaoka-maybe;hp=a7467b62c1588680627f699188bbf6d7702c947b;hpb=7dd0b2af79ffa37042f6325d343a019b7c44db58;p=elisp%2Fapel.git diff --git a/install.el b/install.el index a7467b6..2da8a78 100644 --- a/install.el +++ b/install.el @@ -1,6 +1,6 @@ ;;; install.el --- Emacs Lisp package install utility -;; Copyright (C) 1996,1997,1998,1999 Free Software Foundation, Inc. +;; Copyright (C) 1996,1997,1998,1999,2001 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Created: 1996/08/18 @@ -25,7 +25,7 @@ ;;; Code: -(require 'poe) ; make-directory (for v18) +(require 'poe) ; make-directory for v18 (require 'path-util) ; default-load-path @@ -41,16 +41,17 @@ (byte-compile-file el-file)))) (defun compile-elisp-modules (modules &optional path every-time) - (mapcar (function - (lambda (module) - (compile-elisp-module module path every-time))) - modules)) + (mapcar + (function + (lambda (module) + (compile-elisp-module module path every-time))) + modules)) ;;; @ install files ;;; -(defvar install-overwritten-file-modes (+ (* 64 6)(* 8 4) 4)) +(defvar install-overwritten-file-modes (+ (* 64 6)(* 8 4) 4)) ; 0644 (defun install-file (file src dest &optional move overwrite just-print) (if just-print @@ -61,6 +62,7 @@ (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) @@ -73,12 +75,14 @@ (princ (format "%s -> %s\n" file dest))))))) (defun install-files (files src dest &optional move overwrite just-print) - (or (file-exists-p dest) + (or just-print + (file-exists-p dest) (make-directory dest t)) - (mapcar (function - (lambda (file) - (install-file file src dest move overwrite just-print))) - files)) + (mapcar + (function + (lambda (file) + (install-file file src dest move overwrite just-print))) + files)) ;;; @@ install Emacs Lisp files @@ -98,6 +102,7 @@ (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)) @@ -108,6 +113,7 @@ (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 @@ -118,12 +124,14 @@ (princ (format "%s -> %s\n" elc-file dest)))))))) (defun install-elisp-modules (modules src dest &optional just-print) - (or (file-exists-p dest) + (or just-print + (file-exists-p dest) (make-directory dest t)) - (mapcar (function - (lambda (module) - (install-elisp-module module src dest just-print))) - modules)) + (mapcar + (function + (lambda (module) + (install-elisp-module module src dest just-print))) + modules)) ;;; @ detect install path @@ -131,8 +139,8 @@ ;; install to shared directory (maybe "/usr/local") (defvar install-prefix - (if (or (<= emacs-major-version 18) ; running-emacs-18 - (featurep 'xemacs) ; running-xemacs + (if (or (<= emacs-major-version 18) + (featurep 'xemacs) (and (boundp 'system-configuration-options) ; 19.29 or later (string= system-configuration-options "NT"))) ; for Meadow (expand-file-name "../../.." exec-directory) @@ -141,6 +149,7 @@ (defvar install-elisp-prefix (if (>= emacs-major-version 19) "site-lisp" + ;; v18 does not have standard site directory. "local.lisp")) (defun install-detect-elisp-directory (&optional prefix elisp-prefix @@ -149,46 +158,92 @@ (setq prefix install-prefix)) (or elisp-prefix (setq elisp-prefix install-elisp-prefix)) - (or - (catch 'tag - (let ((rest default-load-path) - (pat (concat "^" - (expand-file-name (concat ".*/" elisp-prefix) prefix) - "/?$"))) - (while rest - (if (string-match pat (car rest)) - (if (or allow-version-specific - (not (string-match (format "/%d\\.%d" - emacs-major-version - emacs-minor-version) - (car rest)))) - (throw 'tag dir))) - (setq rest (cdr rest))))) - (expand-file-name (concat - (if (and ; running-emacs-19_29-or-later - (not (featurep 'xemacs)) - (or (>= emacs-major-version 20) - (and (= emacs-major-version 19) - (>= emacs-minor-version 29)))) - "share/" - "lib/") - (cond ((boundp 'NEMACS) "nemacs/") - ((boundp 'MULE) "mule/") - ((featurep 'xemacs) ; running-xemacs - (if (featurep 'mule) - "xmule/" - "xemacs/")) - (t "emacs/")) - elisp-prefix) - prefix))) + (or (catch 'tag + (let ((rest default-load-path) + (regexp (concat "^" + (expand-file-name (concat ".*/" elisp-prefix) + prefix) + "/?$"))) + (while rest + (if (string-match regexp (car rest)) + (if (or allow-version-specific + (not (string-match (format "/%d\\.%d" + emacs-major-version + emacs-minor-version) + (car rest)))) + (throw 'tag (car rest)))) + (setq rest (cdr rest))))) + (expand-file-name (concat (if (and (not (featurep 'xemacs)) + (or (>= emacs-major-version 20) + (and (= emacs-major-version 19) + (> emacs-minor-version 28)))) + "share/" + "lib/") + (cond + ((featurep 'xemacs) + (if (featurep 'mule) + "xmule/" + "xemacs/")) + ;; unfortunately, unofficial mule based on + ;; 19.29 and later use "emacs/" by default. + ((boundp 'MULE) "mule/") + ((boundp 'NEMACS) "nemacs/") + (t "emacs/")) + elisp-prefix) + prefix))) (defvar install-default-elisp-directory (install-detect-elisp-directory)) +;;; @ for XEmacs package system +;;; + +(defun install-update-package-files (package dir &optional just-print) + (cond + (just-print + (princ (format "Updating autoloads in directory %s..\n\n" dir)) + + (princ (format "Processing %s\n" dir)) + (princ "Generating custom-load.el...\n\n") + + (princ (format "Compiling %s...\n" + (expand-file-name "auto-autoloads.el" dir))) + (princ (format "Wrote %s\n" + (expand-file-name "auto-autoloads.elc" dir))) + + (princ (format "Compiling %s...\n" + (expand-file-name "custom-load.el" dir))) + (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)) + + (let ((command-line-args-left (list dir))) + (Custom-make-dependencies)) + + (byte-compile-file (expand-file-name "auto-autoloads.el" dir)) + (byte-compile-file (expand-file-name "custom-load.el" dir))))) + + +;;; @ Other Utilities +;;; + +(defun install-just-print-p () + (let ((flag (getenv "MAKEFLAGS")) + (case-fold-search nil)) + (princ (format "%s\n" flag)) + (if flag + (string-match "^\\(\\(--[^ ]+ \\)+-\\|[^ =-]\\)*n" flag)))) + + ;;; @ end ;;; -(provide 'install) +(require 'product) +(product-provide (provide 'install) (require 'apel-ver)) ;;; install.el ends here