Source

apel / install.el

Full commit
steve e38873c 

steveb a8b5b6b 
steve e38873c 























yoshiki 833a3fa 
steveb e07b8e4 

steve e38873c 






steveb e07b8e4 
steve e38873c 

steveb e07b8e4 
steve e38873c 

yoshiki 833a3fa 




steve e38873c 




yoshiki 833a3fa 
steve e38873c 
steveb a8b5b6b 






steveb e07b8e4 
steveb a8b5b6b 







steveb e07b8e4 


steve e38873c 
steveb a8b5b6b 
steve e38873c 
steveb e07b8e4 
yoshiki 833a3fa 




steve e38873c 




steveb a8b5b6b 
steve e38873c 


steveb e07b8e4 
steve e38873c 
steveb a8b5b6b 



steve e38873c 

steveb e07b8e4 
steve e38873c 
steveb e07b8e4 
steve e38873c 
steveb a8b5b6b 



steve e38873c 

steveb e07b8e4 
steve e38873c 





steveb e07b8e4 


steve e38873c 
steveb a8b5b6b 
steve e38873c 
steveb e07b8e4 
yoshiki 833a3fa 




steve e38873c 




steveb a8b5b6b 
steve e38873c 
yoshiki 833a3fa 

steveb a8b5b6b 

steve e38873c 
steveb a8b5b6b 
steve e38873c 



yoshiki 833a3fa 
steve e38873c 




steveb e07b8e4 
steve e38873c 
steveb e07b8e4 
yoshiki 833a3fa 
































steve e38873c 







yoshiki 833a3fa 

steve e38873c 
;;; install.el --- Emacs Lisp package install utility

;; Copyright (C) 1996,1997,1998,1999 Free Software Foundation, Inc.

;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Created: 1996/08/18
;; Keywords: install, byte-compile, directory detection

;; 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
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; 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.

;;; Code:

(require 'poe)				; make-directory for v18
(require 'path-util)			; default-load-path


;;; @ 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"))
	(elc-file (concat module ".elc")))
    (if (or every-time
	    (file-newer-than-file-p el-file elc-file))
	(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))


;;; @ install files
;;;

(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
      (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 just-print)
  (or (file-exists-p dest)
      (make-directory dest t))
  (mapcar
   (function
    (lambda (file)
      (install-file file src dest move overwrite just-print)))
   files))


;;; @@ 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 (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)
		(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 (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)
		(condition-case err
		    (progn
		      (delete-file src-file)
		      (throw 'tag nil))
		  (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)
  (or (file-exists-p dest)
      (make-directory dest t))
  (mapcar
   (function
    (lambda (module)
      (install-elisp-module module src dest just-print)))
   modules))


;;; @ detect install path
;;;

;; install to shared directory (maybe "/usr/local")
(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
      (expand-file-name "../../.." exec-directory)
    (expand-file-name "../../../.." data-directory)))

(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
						 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)
	      (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))


;;; @ end
;;;

(require 'product)
(product-provide (provide 'install) (require 'apel-ver))

;;; install.el ends here