X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=install.el;h=835a47ebbe616eef3ca6780c1341ae067bfef663;hb=a1b3d9d3033cf911008478e841582638be013975;hp=f934a6948453f26b8cbbb72acb45fa14dd60904c;hpb=d956e9aa2ebb1d241354eb224cb23c383bfee2c9;p=elisp%2Fapel.git diff --git a/install.el b/install.el index f934a69..835a47e 100644 --- a/install.el +++ b/install.el @@ -1,13 +1,12 @@ ;;; install.el --- Emacs Lisp package install utility -;; Copyright (C) 1996 Free Software Foundation, Inc. +;; Copyright (C) 1996,1997,1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko -;; Created: 1996/8/18 -;; Version: $Id: install.el,v 1.5 1996/08/21 12:08:41 morioka Exp $ -;; Keywords: install +;; Created: 1996/08/18 +;; Keywords: install, byte-compile, directory detection -;; This file is part of tl (Tiny Library). +;; This file is part of APEL (A Portable Emacs Library). ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -20,12 +19,19 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program; see the file COPYING. If not, write to +;; 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. ;;; Code: +(require 'emu) +(require 'path-util) + + +;;; @ compile Emacs Lisp files +;;; + (defun compile-elisp-module (module &optional path every-time) (setq module (expand-file-name (symbol-name module) path)) (let ((el-file (concat module ".el")) @@ -45,57 +51,76 @@ modules)) +;;; @ install files +;;; + (defvar install-overwritten-file-modes (+ (* 64 6)(* 8 4) 4)) -(defun install-file (file src dest &optional move overwrite) - (let ((src-file (expand-file-name file src))) - (if (file-exists-p src-file) - (let ((full-path (expand-file-name file dest))) - (if (and (file-exists-p full-path) overwrite) - (set-file-modes full-path install-overwritten-file-modes) - ) - (copy-file src-file full-path t t) - (if move - (catch 'tag - (while (file-exists-p src-file) - (condition-case err - (progn - (delete-file src-file) - (throw 'tag nil) - ) - (error (princ (format "%s\n" (nth 1 err)))) - )))) - (princ (format "%s -> %s\n" file dest)) - )) - )) +(defun install-file (file src dest &optional move overwrite just-print) + (if just-print + (princ (format "%s -> %s\n" file dest)) + (let ((src-file (expand-file-name file src))) + (if (file-exists-p src-file) + (let ((full-path (expand-file-name file dest))) + (if (and (file-exists-p full-path) overwrite) + (delete-file full-path) + ) + (copy-file src-file full-path t t) + (if move + (catch 'tag + (while (and (file-exists-p src-file) + (file-writable-p src-file)) + (condition-case err + (progn + (delete-file src-file) + (throw 'tag nil) + ) + (error (princ (format "%s\n" (nth 1 err)))) + )))) + (princ (format "%s -> %s\n" file dest)) + )) + ))) -(defun install-files (files src dest &optional move overwrite) +(defun install-files (files src dest &optional move overwrite just-print) (or (file-exists-p dest) (make-directory dest t) ) (mapcar (function (lambda (file) - (install-file file src dest move overwrite) + (install-file file src dest move overwrite just-print) )) files)) -(defun install-elisp-module (module src dest) + +;;; @@ install Emacs Lisp files +;;; + +(defun install-elisp-module (module src dest &optional just-print) (let (el-file elc-file) (let ((name (symbol-name module))) (setq el-file (concat name ".el")) (setq elc-file (concat name ".elc")) ) (let ((src-file (expand-file-name el-file src))) - (if (file-exists-p src-file) + (if (not (file-exists-p src-file)) + nil + (if just-print + (princ (format "%s -> %s\n" el-file dest)) (let ((full-path (expand-file-name el-file dest))) (if (file-exists-p full-path) - (set-file-modes full-path install-overwritten-file-modes) + (delete-file full-path) ) (copy-file src-file full-path t t) (princ (format "%s -> %s\n" el-file dest)) - )) + ))) (setq src-file (expand-file-name elc-file src)) - (if (file-exists-p src-file) + (if (not (file-exists-p src-file)) + nil + (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) (catch 'tag (while (file-exists-p src-file) @@ -107,19 +132,79 @@ (error (princ (format "%s\n" (nth 1 err)))) ))) (princ (format "%s -> %s\n" elc-file dest)) - )) + ))) ))) -(defun install-elisp-modules (modules src dest) +(defun install-elisp-modules (modules src dest &optional just-print) (or (file-exists-p dest) (make-directory dest t) ) (mapcar (function (lambda (module) - (install-elisp-module module src dest) + (install-elisp-module module src dest just-print) )) modules)) +;;; @ detect install path +;;; + +;; install to shared directory (maybe "/usr/local") +(defvar install-prefix + (if (or running-emacs-18 running-xemacs + (and (boundp 'system-configuration-options) ; 19.29 or later + (string= system-configuration-options "NT"))) ; for Meadow + (expand-file-name "../../.." exec-directory) + (expand-file-name "../../../.." data-directory))) + +(defvar install-elisp-prefix + (if (>= emacs-major-version 19) + "site-lisp" + "local.lisp")) + +(defun install-detect-elisp-directory (&optional prefix elisp-prefix + allow-version-specific) + (or prefix + (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) + "/?$")) + dir) + (while (setq dir (car rest)) + (if (string-match pat dir) + (if (or allow-version-specific + (not (string-match (format "/%d\\.%d" + emacs-major-version + emacs-minor-version) dir)) + ) + (throw 'tag dir) + )) + (setq rest (cdr rest)) + ))) + (expand-file-name (concat + (if running-emacs-19_29-or-later + "share/" + "lib/") + (cond ((boundp 'NEMACS) "nemacs/") + ((boundp 'MULE) "mule/") + (running-xemacs + (if (featurep 'mule) + "xmule/" + "xemacs/")) + (t "emacs/")) + elisp-prefix) prefix) + )) + +(defvar install-default-elisp-directory + (install-detect-elisp-directory)) + + ;;; @ end ;;;