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/08/18
   7 ;; Version: $Id: install.el,v 4.2 1997/11/06 15:52:08 morioka Exp $
   8 ;; Keywords: install, byte-compile, directory detection
   9
  10 ;; This file is part of APEL (A Portable Emacs 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 'path-util)
  31
  32
  33 ;;; @ compile Emacs Lisp files
  34 ;;;
  35
  36 (defun compile-elisp-module (module &optional path every-time)
  37   (setq module (expand-file-name (symbol-name module) path))
  38   (let ((el-file (concat module ".el"))
  39         (elc-file (concat module ".elc"))
  40         )
  41     (if (or every-time
  42             (file-newer-than-file-p el-file elc-file))
  43         (byte-compile-file el-file)
  44       )
  45     ))
  46
  47 (defun compile-elisp-modules (modules &optional path every-time)
  48   (mapcar (function
  49            (lambda (module)
  50              (compile-elisp-module module path every-time)
  51              ))
  52           modules))
  53
  54
  55 ;;; @ install files
  56 ;;;
  57
  58 (defvar install-overwritten-file-modes (+ (* 64 6)(* 8 4) 4))
  59
  60 (defun install-file (file src dest &optional move overwrite)
  61   (let ((src-file (expand-file-name file src)))
  62     (if (file-exists-p src-file)
  63         (let ((full-path (expand-file-name file dest)))
  64           (if (and (file-exists-p full-path) overwrite)
  65               (delete-file full-path)
  66             )
  67           (copy-file src-file full-path t t)
  68           (if move
  69               (catch 'tag
  70                 (while (and (file-exists-p src-file)
  71                             (file-writable-p src-file))
  72                   (condition-case err
  73                       (progn
  74                         (delete-file src-file)
  75                         (throw 'tag nil)
  76                         )
  77                     (error (princ (format "%s\n" (nth 1 err))))
  78                     ))))
  79           (princ (format "%s -> %s\n" file dest))
  80           ))
  81     ))
  82
  83 (defun install-files (files src dest &optional move overwrite)
  84   (or (file-exists-p dest)
  85       (make-directory dest t)
  86       )
  87   (mapcar (function (lambda (file)
  88                       (install-file file src dest move overwrite)
  89                       ))
  90           files))
  91
  92
  93 ;;; @@ install Emacs Lisp files
  94 ;;;
  95
  96 (defun install-elisp-module (module src dest)
  97   (let (el-file elc-file)
  98     (let ((name (symbol-name module)))
  99       (setq el-file (concat name ".el"))
 100       (setq elc-file (concat name ".elc"))
 101       )
 102     (let ((src-file (expand-file-name el-file src)))
 103       (if (file-exists-p src-file)
 104           (let ((full-path (expand-file-name el-file dest)))
 105             (if (file-exists-p full-path)
 106                 (delete-file full-path)
 107               )
 108             (copy-file src-file full-path t t)
 109             (princ (format "%s -> %s\n" el-file dest))
 110             ))
 111       (setq src-file (expand-file-name elc-file src))
 112       (if (file-exists-p src-file)
 113           (let ((full-path (expand-file-name elc-file dest)))
 114             (if (file-exists-p full-path)
 115                 (delete-file full-path)
 116               )
 117             (copy-file src-file full-path t t)
 118             (catch 'tag
 119               (while (file-exists-p src-file)
 120                 (condition-case err
 121                     (progn
 122                       (delete-file src-file)
 123                       (throw 'tag nil)
 124                       )
 125                   (error (princ (format "%s\n" (nth 1 err))))
 126                   )))
 127             (princ (format "%s -> %s\n" elc-file dest))
 128             ))
 129       )))
 130
 131 (defun install-elisp-modules (modules src dest)
 132   (or (file-exists-p dest)
 133       (make-directory dest t)
 134       )
 135   (mapcar (function (lambda (module)
 136                       (install-elisp-module module src dest)
 137                       ))
 138           modules))
 139
 140
 141 ;;; @ detect install path
 142 ;;;
 143
 144 (defvar install-prefix
 145   (if (or running-emacs-18 running-xemacs)
 146       (expand-file-name "../../.." exec-directory)
 147     (expand-file-name "../../../.." data-directory)
 148     )) ; install to shared directory (maybe "/usr/local")
 149
 150 (defvar install-elisp-prefix
 151   (if (>= emacs-major-version 19)
 152       "site-lisp"
 153     "local.lisp"))
 154
 155 (defun install-detect-elisp-directory (&optional prefix elisp-prefix
 156                                                  allow-version-specific)
 157   (or prefix
 158       (setq prefix install-prefix)
 159       )
 160   (or elisp-prefix
 161       (setq elisp-prefix install-elisp-prefix)
 162       )
 163   (or
 164    (catch 'tag
 165      (let ((rest default-load-path)
 166            dir)
 167        (while (setq dir (car rest))
 168          (if (string-match
 169               `,(concat "^"
 170                         (expand-file-name (concat ".*/" elisp-prefix) prefix)
 171                         "/?$")
 172               dir)
 173              (if (or allow-version-specific
 174                      (not (string-match (format "%d\\.%d"
 175                                                 emacs-major-version
 176                                                 emacs-minor-version) dir))
 177                      )
 178                  (throw 'tag dir)
 179                ))
 180          (setq rest (cdr rest))
 181          )))
 182    (expand-file-name (concat
 183                       (if running-emacs-19_29-or-later
 184                           "share/"
 185                         "lib/")
 186                       (cond ((boundp 'NEMACS) "nemacs/")
 187                             ((boundp 'MULE)   "mule/")
 188                             (running-xemacs
 189                              (if (featurep 'mule)
 190                                  "xmule/"
 191                                "xemacs/"))
 192                             (t "emacs/"))
 193                       elisp-prefix) prefix)
 194    ))
 195
 196 (defvar install-default-elisp-directory
 197   (install-detect-elisp-directory))
 198
 199
 200 ;;; @ end
 201 ;;;
 202
 203 (provide 'install)
 204
 205 ;;; install.el ends here