install.el

   1 ;;; install.el --- Emacs Lisp package install utility
   2
   3 ;; Copyright (C) 1996 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Created: 1996/8/18
   7 ;; Version: $Id: install.el,v 3.1 1996/11/26 19:55:55 shuhei-k Exp $
   8 ;; Keywords: install
   9
  10 ;; This file is part of tl (Tiny Library).
  11
  12 ;; This program is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 2, or (at
  15 ;; your option) any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Code:
  28
  29 (require 'emu)
  30 (require 'file-detect)
  31
  32 ;;; @ compile Emacs Lisp files
  33 ;;;
  34
  35 (defun compile-elisp-module (module &optional path every-time)
  36   (setq module (expand-file-name (symbol-name module) path))
  37   (let ((el-file (concat module ".el"))
  38         (elc-file (concat module ".elc"))
  39         )
  40     (if (or every-time
  41             (file-newer-than-file-p el-file elc-file))
  42         (byte-compile-file el-file)
  43       )
  44     ))
  45
  46 (defun compile-elisp-modules (modules &optional path every-time)
  47   (mapcar (function
  48            (lambda (module)
  49              (compile-elisp-module module path every-time)
  50              ))
  51           modules))
  52
  53
  54 ;;; @ install files
  55 ;;;
  56
  57 (defvar install-overwritten-file-modes (+ (* 64 6)(* 8 4) 4))
  58
  59 (defun install-file (file src dest &optional move overwrite)
  60   (let ((src-file (expand-file-name file src)))
  61     (if (file-exists-p src-file)
  62         (let ((full-path (expand-file-name file dest)))
  63           (if (and (file-exists-p full-path) overwrite)
  64               (delete-file full-path)
  65             )
  66           (copy-file src-file full-path t t)
  67           (if move
  68               (catch 'tag
  69                 (while (and (file-exists-p src-file)
  70                             (file-writable-p src-file))
  71                   (condition-case err
  72                       (progn
  73                         (delete-file src-file)
  74                         (throw 'tag nil)
  75                         )
  76                     (error (princ (format "%s\n" (nth 1 err))))
  77                     ))))
  78           (princ (format "%s -> %s\n" file dest))
  79           ))
  80     ))
  81
  82 (defun install-files (files src dest &optional move overwrite)
  83   (or (file-exists-p dest)
  84       (make-directory dest t)
  85       )
  86   (mapcar (function (lambda (file)
  87                       (install-file file src dest move overwrite)
  88                       ))
  89           files))
  90
  91
  92 ;;; @@ install Emacs Lisp files
  93 ;;;
  94
  95 (defun install-elisp-module (module src dest)
  96   (let (el-file elc-file)
  97     (let ((name (symbol-name module)))
  98       (setq el-file (concat name ".el"))
  99       (setq elc-file (concat name ".elc"))
 100       )
 101     (let ((src-file (expand-file-name el-file src)))
 102       (if (file-exists-p src-file)
 103           (let ((full-path (expand-file-name el-file dest)))
 104             (if (file-exists-p full-path)
 105                 (delete-file full-path)
 106               )
 107             (copy-file src-file full-path t t)
 108             (princ (format "%s -> %s\n" el-file dest))
 109             ))
 110       (setq src-file (expand-file-name elc-file src))
 111       (if (file-exists-p src-file)
 112           (let ((full-path (expand-file-name elc-file dest)))
 113             (if (file-exists-p full-path)
 114                 (delete-file full-path)
 115               )
 116             (copy-file src-file full-path t t)
 117             (catch 'tag
 118               (while (file-exists-p src-file)
 119                 (condition-case err
 120                     (progn
 121                       (delete-file src-file)
 122                       (throw 'tag nil)
 123                       )
 124                   (error (princ (format "%s\n" (nth 1 err))))
 125                   )))
 126             (princ (format "%s -> %s\n" elc-file dest))
 127             ))
 128       )))
 129
 130 (defun install-elisp-modules (modules src dest)
 131   (or (file-exists-p dest)
 132       (make-directory dest t)
 133       )
 134   (mapcar (function (lambda (module)
 135                       (install-elisp-module module src dest)
 136                       ))
 137           modules))
 138
 139
 140 ;;; @ detect install path
 141 ;;;
 142
 143 (defvar install-prefix
 144   (if (or running-emacs-18 running-xemacs)
 145       (expand-file-name "../../.." exec-directory)
 146     (expand-file-name "../../../.." data-directory)
 147     )) ; install to shared directory (maybe "/usr/local")
 148
 149 (defvar install-elisp-prefix
 150   (if (>= emacs-major-version 19)
 151       "site-lisp"
 152     "local.lisp"))
 153
 154 (defun install-detect-elisp-directory (&optional prefix elisp-prefix
 155                                                  allow-version-specific)
 156   (or prefix
 157       (setq prefix install-prefix)
 158       )
 159   (or elisp-prefix
 160       (setq elisp-prefix install-elisp-prefix)
 161       )
 162   (or
 163    (catch 'tag
 164      (let ((rest default-load-path)
 165            dir)
 166        (while (setq dir (car rest))
 167          (if (string-match
 168               (concat "^"
 169                       (expand-file-name (concat ".*/" elisp-prefix) prefix)
 170                       "$")
 171               dir)
 172              (if (or allow-version-specific
 173                      (not (string-match (format "%d\\.%d"
 174                                                 emacs-major-version
 175                                                 emacs-minor-version) dir))
 176                      )
 177                  (throw 'tag dir)
 178                ))
 179          (setq rest (cdr rest))
 180          )))
 181    (expand-file-name (concat
 182                       (if running-emacs-19_29-or-later
 183                           "share/"
 184                         "lib/")
 185                       (cond ((boundp 'NEMACS) "nemacs/")
 186                             ((boundp 'MULE)   "mule/")
 187                             (running-xemacs
 188                              (if (featurep 'mule)
 189                                  "xmule/"
 190                                "xemacs/"))
 191                             (t "emacs/"))
 192                       elisp-prefix) prefix)
 193    ))
 194
 195 (defvar install-default-elisp-directory
 196   (install-detect-elisp-directory))
 197
 198
 199 ;;; @ end
 200 ;;;
 201
 202 (provide 'install)
 203
 204 ;;; install.el ends here